Utilisation d'une case à cocher

**SkyCorp** · 28/10/2011, 07h53

Bonjour,

Ma question est toute simple mais j'ai du mal à trouver la solution.
J'ai une case à cocher activeX baptisée "EchellePerso" sur ma feuille Excel.
Je souhaiterai pouvoir lire dans l'un de mes modules la valeur de cette checkbox, mais j'ai à chaque fois des messages d'erreurs :

* Si j'écris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim oSheet As Excel.Worksheet ' Feuille
Dim EchelleInfo As Boolean
Set oSheet = ActiveSheet
Set EchelleInfo = oSheet.EchellePerso.Value

j'ai l'erreur suivante :
"Erreur de compilation: Membre de méthode ou de données introuvable" en me pointant l'erreur sur ".EchellePerso"

* Si j'écris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim oSheet As Excel.Worksheet ' Feuille
Dim EchelleInfo As Boolean
Set oSheet = ActiveSheet
Set EchelleInfo = oSheet.OLEObjects("EchellePerso").Object.Value

j'ai l'erreur suivante :
"Erreur de compilation: Objet requis" en me surlignant "EchelleInfo ="

Quelqu'un peut me dire quelle est la syntaxe exacte ?

**jfontaine** · 28/10/2011, 11h12

Bonjour,

Essais comme cela (sans le SET)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim oSheet As Excel.Worksheet ' Feuille
Dim EchelleInfo As Boolean
Set oSheet = ActiveSheet
EchelleInfo = oSheet.EchellePerso.Value

**SkyCorp** · 28/10/2011, 23h12

Bonsoir ,

Je viens d'essayer mais j'ai à nouveau l'erreur suivante :
"Erreur de compilation: Membre de méthode ou de données introuvable", en me surlignant à nouveau ".EchelleInfo"

**jfontaine** · 28/10/2011, 23h22

Peux tu mettre ton code

**SkyCorp** · 29/10/2011, 00h21

Voici une partie de mon code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim oSheet As Excel.Worksheet ' Feuille
Dim valEchelle() As Double ' Valeurs de l'échelle
Dim i As Integer
Dim EchelleInfo As Boolean
 
' Feuille contenant la carte
Set oSheet = ActiveSheet
EchelleInfo = oSheet.EchellePerso.Value
'Set EchelleInfo = oSheet.OLEObjects("EchellePerso").Object.Value
 
If EchelleInfo = True Then
    For i = 1 To UBound(couleurs) + 1
        valEchelle(i) = oSheet.Range("E7:E22")
    Next
End If

Si ça ne suffit pas, voici la totalité du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Option Explicit
 
 
' Fonctions fixant un nombre de chiffres significatifs à une valeur
' precision exprime le nombre de décimales voulu
Public Function ArrondiSup(x As Double, precision As Integer) As Double
    Dim n As Integer
    Dim y As Double
    n = Int(Log10(x))
    y = Exp10(Log10(x) - n)
    ArrondiSup = Round(y, precision) * 10 ^ n
End Function
 
Public Function ArrondiInf(x As Double, precision As Integer) As Double
    Dim n As Integer
    Dim y As Double
    If x > 0 Then
        n = Int(Log10(x))
        y = Exp10(Log10(x) - n) - 10 ^ -precision
        ArrondiInf = Round(y, precision) * 10 ^ n
    Else
        ArrondiInf = 0
    End If
End Function
 
Public Function Exp10(x As Double) As Double
    Exp10 = Exp(x * Log(10))
End Function
 
Public Function Log10(x As Double) As Double
    Log10 = Log(x) / Log(10)
End Function
 
 
'--------------------------------------------------------------------------------
' Colore la carte en fonction de la progression du CA
'--------------------------------------------------------------------------------
Sub ColorMap()
Dim oSheet As Excel.Worksheet ' Feuille
Dim lLine As Long ' Numéro de ligne
Dim loShape As Shape ' Forme
Dim lColor, varcolor As Long ' Couleur
Dim nbCouleur As Integer ' Nombre de couleurs dans l'échelle de couleurs)
Dim couleurs() As Long ' Echelle de couleurs
Dim valMin, valMax, valtarget As Double ' Valeurs min et max
Dim valDelta As Single ' max-min+1
Dim valEchelle() As Double ' Valeurs de l'échelle
Dim strLegende, strval1, strval2 As String ' Texte de la légende
Dim Cellules As Range ' Colonne à évaluer
Dim i As Integer
Dim EchelleInfo As Boolean
 
'Définit la taille de l'échelle de couleurs
nbCouleur = 15
ReDim couleurs(nbCouleur)
' Echelle de couleur
couleurs(1) = RGB(51, 0, 0)   ' Rouge pour les valeurs min
couleurs(2) = RGB(128, 0, 0)
couleurs(3) = RGB(165, 0, 33)
couleurs(4) = RGB(204, 0, 0)
couleurs(5) = RGB(255, 0, 0)
couleurs(6) = RGB(255, 102, 0)
couleurs(7) = RGB(255, 153, 51)
couleurs(8) = RGB(255, 204, 102)
couleurs(9) = RGB(255, 255, 102)
couleurs(10) = RGB(204, 255, 102)
couleurs(11) = RGB(153, 255, 51)
couleurs(12) = RGB(102, 255, 51)
couleurs(13) = RGB(0, 153, 0)
couleurs(14) = RGB(0, 128, 0)
couleurs(15) = RGB(0, 51, 0)   ' Vert pour les valeurs max
 
' Feuille contenant la carte
Set oSheet = ActiveSheet
EchelleInfo = oSheet.EchellePerso.Value
'Set EchelleInfo = oSheet.OLEObjects("EchellePerso").Object.Value
 
' Plage de données
Set Cellules = oSheet.Range("C2:C531")
' Valeurs min et max et grille de valeurs de la plage de données
valMin = Application.WorksheetFunction.Min(Cellules)
valMax = Application.WorksheetFunction.Max(Cellules)
valDelta = (valMax - valMin) / nbCouleur
 
ReDim valEchelle(nbCouleur + 1)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If EchelleInfo = True Then
    For i = 1 To UBound(couleurs) + 1
        valEchelle(i) = oSheet.Range("E7:E22")
    Next
Else
    For i = 1 To UBound(couleurs) + 1
        valtarget = valMin + (i - 1) * valDelta
        If i = 1 Then
            valEchelle(i) = ArrondiInf(valtarget, 2)
        Else
            valEchelle(i) = ArrondiSup(valtarget, 2)
        End If
    Next
End If
 
' Légende
' Désactive le remplissage de la légende
oSheet.Shapes("Légende").Fill.Visible = msoFalse
' Complète la légende de la valeur la plus faible (valEchelle(1)-> valMin) à la valeur la plus élevée (valEchelle(max) -> valMax)
For Each loShape In oSheet.Shapes("Légende").GroupItems
    ' Couleurs de remplissage
    For i = 1 To UBound(couleurs)
        ' Si la forme loShape contient le nom Legende
        If loShape.Name = "Legende " & i Then
            ' Réactive le remplissage de la forme
            loShape.Fill.Visible = True
            ' Type de remplissage = couleur unie
            loShape.Fill.Solid
            ' Pas de transparence
            loShape.Fill.Transparency = 0#
            ' Couleur de remplissage
            loShape.Fill.ForeColor.RGB = couleurs(i)
            ' Texte de la légende
            strLegende = FormatNumber(valEchelle(i), 0) & " - " & FormatNumber(valEchelle(i + 1), 0)
            loShape.TextFrame.Characters.Text = strLegende
            ' La forme a été trouvée => on sort de la boucle
            Exit For
        End If
    Next i
Next
 
' Désactive le remplissage de la carte
oSheet.Shapes("CarteBasRhin").Fill.Visible = msoFalse
' Pour chaque ligne de la feuille
For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
    ' Couleurs de remplissage
    If IsEmpty(oSheet.Cells(lLine, 1)) Then
        Exit For
    ElseIf IsNumeric(oSheet.Cells(lLine, 3)) = False Then
        lColor = 0
    ElseIf oSheet.Cells(lLine, 3) = valMax Then
        lColor = couleurs(UBound(couleurs))
    Else
        lColor = couleurs(Int((oSheet.Cells(lLine, 3) - valMin) / valDelta) + 1)
    End If
 
    ' Parcours les départements de la carte
    For Each loShape In oSheet.Shapes("CarteBasRhin").GroupItems
        ' Si le nom de la forme loShape contient la valeur de la première colonne
        If loShape.Name Like oSheet.Cells(lLine, 1) & "*" Then
            ' Réactive le remplissage de la forme
            loShape.Fill.Visible = True
            ' Type de remplissage = couleur unie
            loShape.Fill.Solid
            ' Pas de transparence
            loShape.Fill.Transparency = 0#
            ' Couleur de remplissage
            If lColor = 0 Then
                loShape.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
'                loShape.Fill.ForeColor.TintAndShade = 0
                loShape.Fill.ForeColor.Brightness = 0.25
                loShape.Fill.BackColor.ObjectThemeColor = msoThemeColorBackground1
'                loShape.Fill.BackColor.TintAndShade = 0
                loShape.Fill.BackColor.Brightness = 0
                loShape.Fill.Patterned msoPatternOutlinedDiamond
            Else
                loShape.Fill.ForeColor.RGB = lColor
            End If
        End If
    Next
Next
End Sub

**gFZT82** · 29/10/2011, 09h49

Bonjour,

As-tu essayé sans le Set

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

EchelleInfo = oSheet.OLEObjects("EchellePerso").Object.Value

Cordialement.

**SkyCorp** · 29/10/2011, 11h02

J'étais un peu trop fatigué hier soir je crois, j'ai oublié de tester l'autre ligne sans le set

En tout cas, mis à part d'autres petites erreurs de programmation sans rapport, tout marche bien.
Il s'agit bien de cette ligne, sans le Set donc.

Merci

Utilisation d'une case à cocher

Macros et VBA Excel

Discussions similaires

Partager

Partager