Test: CODE - BBCODE - #1

cromagno

Excel/VBA Expert
Supermoderatore
Expert
9 Agosto 2015
6.555
83
39
Sardegna
2013 (64 bit)
216
direttamente copiato dall'editor VBA ed incollato nel generatore di BBCODE:

Codice:

 

cromagno

Excel/VBA Expert
Supermoderatore
Expert
9 Agosto 2015
6.555
83
39
Sardegna
2013 (64 bit)
216
incollato nell'editor del forum e successivamente copiato ed incollato nel generatore BBCODE:

First Step

Codice:
Sub apertura()

    Dim RangeID
    Dim CorrID As Variant
    Dim xxx As Range
    Dim Cella As Range
    Dim RngDest As Range
    
    Call init
    Set RangeID = Range(wsTable.Cells(2, 1), wsTable.Cells(Rows.Count, 1).End(xlUp)) 'range dinamico degli ID che creo io e che devo associare
    Set RngDest = wscalc.Range("B2:B" & wscalc.Range("B" & Rows.Count).Row)
    
    For Each Cella In RangeID
        CorrID = Cella.Value
        Set xxx = RngDest.Find(CorrID, , xlValues, xlWhole)
        If Not xxx Is Nothing Then
            MsgBox CorrID & " trovato: posizione " & xxx.Row
            'copio nome cognome e faccio le mie cose
            'GoTo Qui
        Else
            MsgBox "non trovato e non faccio nulla"
        End If
    
        'Next
        'Qui:
    Next Cella
End Sub
Second Step

Codice:

 

klingklang

Ciappinaro VBA_Expert
Expert
20 Ottobre 2017
4.531
113
42
San Giovanni in Persiceto (BO)
www.excelswissknife.com
2016, 365
302
Codice:
[COLOR=#0000ff]Sub[/COLOR] apertura()


    [COLOR=#0000ff]Dim[/COLOR] RangeID
    [COLOR=#0000ff]Dim[/COLOR] CorrID [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Variant[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] xxx [COLOR=#0000ff]As[/COLOR] Range
    [COLOR=#0000ff]Dim[/COLOR] Cella [COLOR=#0000ff]As[/COLOR] Range
    [COLOR=#0000ff]Dim[/COLOR] RngDest [COLOR=#0000ff]As[/COLOR] Range
    
    [COLOR=#0000ff]Call[/COLOR] init
    [COLOR=#0000ff]Set[/COLOR] RangeID = Range(wsTable.Cells(2, 1), wsTable.Cells(Rows.Count, 1).[COLOR=#0000ff]End[/COLOR](xlUp)) [COLOR=#008000]'range dinamico degli ID che creo io e che devo associare[/COLOR]
    [COLOR=#0000ff]Set[/COLOR] RngDest = wscalc.Range("B2:B" & wscalc.Range("B" & Rows.Count).Row)
    
    [COLOR=#0000ff]For[/COLOR] [COLOR=#0000ff]Each[/COLOR] Cella In RangeID
        CorrID = Cella.Value
        [COLOR=#0000ff]Set[/COLOR] xxx = RngDest.Find(CorrID, , xlValues, xlWhole)
        [COLOR=#0000ff]If[/COLOR] [COLOR=#0000ff]Not[/COLOR] xxx [COLOR=#0000ff]Is[/COLOR] [COLOR=#0000ff]Nothing[/COLOR] [COLOR=#0000ff]Then[/COLOR]
            MsgBox CorrID & "trovato: posizione" & xxx.Row
            [COLOR=#008000]'copio nome cognome e faccio le mie cose[/COLOR]
            [COLOR=#008000]'GoTo Qui[/COLOR]
        [COLOR=#0000ff]Else[/COLOR]
            MsgBox "non trovato e non faccio nulla"
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR]
    
        [COLOR=#008000]'Next[/COLOR]
        [COLOR=#008000]'Qui:[/COLOR]
    [COLOR=#0000ff]Next[/COLOR] Cella
[COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]Sub[/COLOR]
 

cromagno

Excel/VBA Expert
Supermoderatore
Expert
9 Agosto 2015
6.555
83
39
Sardegna
2013 (64 bit)
216
next test:
Codice:
[COLOR=#0000ff]Sub[/COLOR] apertura()

    [COLOR=#0000ff]Dim[/COLOR] RangeID
    [COLOR=#0000ff]Dim[/COLOR] CorrID [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Variant[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] xxx [COLOR=#0000ff]As[/COLOR] Range
    [COLOR=#0000ff]Dim[/COLOR] Cella [COLOR=#0000ff]As[/COLOR] Range
    [COLOR=#0000ff]Dim[/COLOR] RngDest [COLOR=#0000ff]As[/COLOR] Range
    
    [COLOR=#0000ff]Call[/COLOR] init
    [COLOR=#0000ff]Set[/COLOR] RangeID = Range(wsTable.Cells(2, 1), wsTable.Cells(Rows.Count, 1).[COLOR=#0000ff]End[/COLOR](xlUp)) [COLOR=#008000]'range dinamico degli ID che creo io e che devo associare[/COLOR]
    [COLOR=#0000ff]Set[/COLOR] RngDest = wscalc.Range("B2:B" & wscalc.Range("B" & Rows.Count).Row)
    
    [COLOR=#0000ff]For[/COLOR] [COLOR=#0000ff]Each[/COLOR] Cella In RangeID
        CorrID = Cella.Value
        [COLOR=#0000ff]Set[/COLOR] xxx = RngDest.Find(CorrID, , xlValues, xlWhole)
        [COLOR=#0000ff]If[/COLOR] [COLOR=#0000ff]Not[/COLOR] xxx [COLOR=#0000ff]Is[/COLOR] [COLOR=#0000ff]Nothing[/COLOR] [COLOR=#0000ff]Then[/COLOR]
            MsgBox CorrID & " trovato: posizione " & xxx.Row
            [COLOR=#008000]'copio nome cognome e faccio le mie cose[/COLOR]
            [COLOR=#008000]'GoTo Qui[/COLOR]
        [COLOR=#0000ff]Else[/COLOR]
            MsgBox "non trovato e non faccio nulla"
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR]
    
        [COLOR=#008000]'Next[/COLOR]
        [COLOR=#008000]'Qui:[/COLOR]
    [COLOR=#0000ff]Next[/COLOR] Cella
[COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]Sub[/COLOR]
 

Rubik72

Excel/VBA Expert
Supermoderatore
Expert
12 Dicembre 2015
5.545
83
47
Cosenza
Excel 2016
182
Codice:
[COLOR=#0000ff]Sub[/COLOR] InserisciImmagineCommento()
   [COLOR=#0000ff]Dim[/COLOR] sImmagine [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]
   [COLOR=#0000ff]Dim[/COLOR] sPath [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]
   [COLOR=#0000ff]Dim[/COLOR] c [COLOR=#0000ff]As[/COLOR] Range
   [COLOR=#0000ff]Dim[/COLOR] rng [COLOR=#0000ff]As[/COLOR] Range
   [COLOR=#0000ff]Dim[/COLOR] sh [COLOR=#0000ff]As[/COLOR] Worksheet
   [COLOR=#0000ff]Dim[/COLOR] lLarghezza [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Long[/COLOR]


   sPath = "D:\Immagini\" [COLOR=#008000]'modificare il percorso delle immagini[/COLOR]
   [COLOR=#0000ff]Set[/COLOR] sh = Worksheets("Foglio1") [COLOR=#008000]'assegna la variabile del Foglio[/COLOR]


    [COLOR=#0000ff]With[/COLOR] sh
        [COLOR=#0000ff]Set[/COLOR] rng = .Range("a2:a" & .Range("A" & Rows.Count).[COLOR=#0000ff]End[/COLOR](xlUp).Row) [COLOR=#008000]'assegna la variabile del range in colonna A[/COLOR]
        [COLOR=#0000ff]For[/COLOR] [COLOR=#0000ff]Each[/COLOR] c In rng     [COLOR=#008000]'Le istruzioni For Each...Next consentono di ripetere un blocco di istruzioni[/COLOR]
            [COLOR=#0000ff]If[/COLOR] c.Value <> "" [COLOR=#0000ff]Then[/COLOR] [COLOR=#008000]'controlla che la cella non sia vuota[/COLOR]
                sImmagine = sPath & c.Value & ".jpg" [COLOR=#008000]'assegna la variabile con il percorso dell'immagine[/COLOR]
                [COLOR=#0000ff]If[/COLOR] Dir(sImmagine) <> "" [COLOR=#0000ff]Then[/COLOR] [COLOR=#008000]'ricerca l'immagine[/COLOR]
                    c.AddComment [COLOR=#008000]'aggiunge un commento[/COLOR]
                    c.Comment.Visible = [COLOR=#0000ff]False[/COLOR] [COLOR=#008000]'rende invisibile il commento (visibile solo su slelezione cella)[/COLOR]
                    c.Comment.[COLOR=#0000ff]Text[/COLOR] Text:="" [COLOR=#008000]'scuota il commento del testo[/COLOR]
                    c.Comment.Shape.Fill.UserPicture (sImmagine) [COLOR=#008000]'assegna l'immagine al commento[/COLOR]
                    [COLOR=#0000ff]With[/COLOR] c.Font [COLOR=#008000]'modifica il font[/COLOR]
                        .Name = "Tahoma"
                        .FontStyle = "Grassetto"
                        .Size = 9
                        .Strikethrough = [COLOR=#0000ff]False[/COLOR]
                        .Superscript = [COLOR=#0000ff]False[/COLOR]
                        .Subscript = [COLOR=#0000ff]False[/COLOR]
                        .OutlineFont = [COLOR=#0000ff]False[/COLOR]
                        .Shadow = [COLOR=#0000ff]False[/COLOR]
                        .Underline = xlUnderlineStyleNone
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .ThemeFont = xlThemeFontNone
                    [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]With[/COLOR]
                [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR]
            [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR]
        [COLOR=#0000ff]Next[/COLOR]
    [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]With[/COLOR]


   [COLOR=#0000ff]Set[/COLOR] c = [COLOR=#0000ff]Nothing[/COLOR]
   [COLOR=#0000ff]Set[/COLOR] rng = [COLOR=#0000ff]Nothing[/COLOR]
   [COLOR=#0000ff]Set[/COLOR] sh = [COLOR=#0000ff]Nothing[/COLOR]
[COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]Sub[/COLOR]
:ok:
 

klingklang

Ciappinaro VBA_Expert
Expert
20 Ottobre 2017
4.531
113
42
San Giovanni in Persiceto (BO)
www.excelswissknife.com
2016, 365
302
Codice:
.AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "descrizione del tipo di file tre", "*.xlsx"
        .Filters.Add "descrizione del tipo di file uno", "*.xls"
        .Filters.Add "descrizione del tipo di file due", "*.txt"
        .FilterIndex = 1
RTF (BB code):
.AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "descrizione del tipo di file tre", "*.xlsx"
        .Filters.Add "descrizione del tipo di file uno", "*.xls"
        .Filters.Add "descrizione del tipo di file due", "*.txt"
        .FilterIndex = 1
C-like:
.AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "descrizione del tipo di file tre", "*.xlsx"
        .Filters.Add "descrizione del tipo di file uno", "*.xls"
        .Filters.Add "descrizione del tipo di file due", "*.txt"
        .FilterIndex = 1
 

klingklang

Ciappinaro VBA_Expert
Expert
20 Ottobre 2017
4.531
113
42
San Giovanni in Persiceto (BO)
www.excelswissknife.com
2016, 365
302
RTF (BB code):
.AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "descrizione del tipo di file tre", "*.xlsx"
        .Filters.Add "descrizione del tipo di file uno", "*.xls"
        .Filters.Add "descrizione del tipo di file due", "*.txt"
        .FilterIndex = 1
Eh vabbé ci ho provato... non ci speravo comunque 😜
 

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!