[XL-2010] Utiliser Intelisens pour accéder à des objets d'un classeur ou d'une feuille.

Bonjour à vous.

Voici du code qui permet de créer des propriétés VBA correspondant aux objets suivants :

Table de données (ListObject)
Tableau croisé dynamique (PivotTable)
Plage nommée, ou zone nommée, (range) de classeur ou de feuille.
Image (Shape,, type msoPicture)
Graphique (ChartObject)

Cela permet ensuite d'utiliser des choses comme fMaFeuille.TCD.TableRange1 ou thisWorkBook.NomMaZone.value="UneValeur" au lieu de fMaFeuille.PivotTables("TCD").TableRange1 et d'un truc horrible pour le nom dans le classeur. Ceci évite aussi de découvrir qu'on a fait une faute de frappe sur le nom de l'objet quand le code plante au moment de l'exécution.

Notez que c'est un travail en cours et qu'il est sans doute imparfait et ne couvre très probablement pas tous les cas possibles.
Je n'ai géré et fait que ce dont j'avais besoin.
Une fois les propriétés générées, il faut les copier à la mains dans le code.
Ceci pour les raisons suivantes :

La machine sur laquelle je travaille me bloque l'accès à l'objet VBE.
J'ai découvert des objets cachés de Excel qui ne m'intéressent pas et que je ne souhaite pas intégrer à mon code.
Je n'ai pas envie d'avoir des bugs automatiquement ajoutés à mon code si le code que je génère est imparfait.

Évidement comme c'est du code fixe, si on change le nom d'un des objets ou qu'on le supprime, le code ne s'adapte pas automatiquement mais la version "standard" non plus :-).

Voici donc le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Function ComposerVBAPropriete_Classeur(prmClasseur As Workbook) As String
 
    Dim result As String
 
    Dim o As Object
 
    For Each o In prmClasseur.Names
 
        'Debug.Print o.name
 
        If Not o.name Like "*!*" Then
 
            If result <> "" Then
                result = result & vbNewLine
            End If
 
            result = result & ComposerVBAPropriete(o)
        End If
 
    Next o
 
    ComposerVBAPropriete_Classeur = result
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Function ComposerVBAPropriete_Feuille(prmFeuille As Worksheet) As String
    Dim result As String
 
    Dim o As Object
 
    For Each o In prmFeuille.ListObjects
        result = result & ComposerVBAPropriete(o)
    Next o
 
    For Each o In prmFeuille.Names
        result = result & ComposerVBAPropriete(o)
    Next o
 
    For Each o In prmFeuille.PivotTables
        result = result & ComposerVBAPropriete(o)
    Next o
 
    For Each o In prmFeuille.ChartObjects
        result = result & ComposerVBAPropriete(o)
    Next o
 
    Dim s As Shape
 
    For Each s In prmFeuille.Shapes
 
        If s.Type = msoPicture Then
            result = result & ComposerVBAPropriete(s)
        End If
 
    Next s
 
    ComposerVBAPropriete_Feuille = result
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Private Function ComposerVBAPropriete(prmObjet As Object) As String
    Dim result As String: result = ""
 
    Dim typeObjet As String
    Dim nomObjet As String: nomObjet = prmObjet.name 'Vrai pour la plus part des objets
    Dim nomPropriete As String: nomPropriete = Replace(nomObjet, " ", "_") 'Vrai pour la plus part des objets
 
    If TypeOf prmObjet Is ListObject Then
            typeObjet = "ListObject"
            result = "public property get " & nomPropriete & " as " & typeObjet
            result = result & vbNewLine & "    set " & nomPropriete & "=me." & typeObjet & "s(""" & nomObjet & """)"
            result = result & vbNewLine & "end sub"
            result = result & vbNewLine & ""
 
    ElseIf TypeOf prmObjet Is PivotTable Then
            typeObjet = "PivotTable"
            result = "public property get " & nomPropriete & " as " & typeObjet
            result = result & vbNewLine & "    set " & nomPropriete & "=me." & typeObjet & "s(""" & nomObjet & """)"
            result = result & vbNewLine & "end sub"
            result = result & vbNewLine & ""
 
    ElseIf TypeOf prmObjet Is name Then
            typeObjet = "Range"
            Dim t() As String: t = Split(nomPropriete, "!")
            nomPropriete = t(UBound(t)): nomPropriete = Replace(nomPropriete, " ", "_")
            nomObjet = t(UBound(t))
 
            result = "public property get " & nomPropriete & " as " & typeObjet
 
            If prmObjet.name Like "*!*" Then
                    'Feuille
                    result = result & vbNewLine & "    set " & nomPropriete & "=me.range(""" & nomObjet & """)"
                Else
                    'Classeur
                    result = result & vbNewLine & "    dim n as name: set n=ThisWorkBook.Names(""" & prmObjet.name & """)"
                    result = result & vbNewLine & "    dim t() as string: t=split(Mid(n.RefersTo, 2), ""!"")"
                    result = result & vbNewLine & "    dim nomFeuille as string:nomFeuille=t(0)"
                    result = result & vbNewLine & "    dim adresse as string:adresse=t(1)"
                    result = result & vbNewLine & "    set " & nomPropriete & "=ThisWorkbook.Worksheets(nomFeuille).Range(adresse)"
                    result = result & vbNewLine & "    set n=nothing"
            End If
 
            result = result & vbNewLine & "end sub"
            result = result & vbNewLine & ""
 
    ElseIf TypeOf prmObjet Is Shape Then 'Image
 
            Select Case prmObjet.Type
                Case msoPicture
                    typeObjet = "Shape"
 
                Case Else
                    Call Err.Raise(5, , Error$(5) & " - Type de forme invalide.")
            End Select
 
            nomObjet = prmObjet.name
            nomPropriete = Replace(nomObjet, " ", "_")
            result = "public property get " & nomPropriete & " as " & typeObjet
            result = result & vbNewLine & "    set " & nomPropriete & "=me." & typeObjet & "s(""" & nomObjet & """)"
            result = result & vbNewLine & "end sub"
            result = result & vbNewLine & ""
 
    ElseIf TypeOf prmObjet Is ChartObject Then
            typeObjet = "ChartObject"
 
            result = "public property get " & nomPropriete & " as " & typeObjet
            result = result & vbNewLine & "    set " & nomPropriete & "=me." & typeObjet & "s(""" & nomObjet & """)"
            result = result & vbNewLine & "end sub"
            result = result & vbNewLine & ""
 
        Else
            Call Err.Raise(5, , Error$(5) & " - Type d'objet invalide.")
    End If
 
    ComposerVBAPropriete = result
End Function

A+