Discussion :

[anarchiste-mouton]

Bonjour,

J'essai de faire une petite macro pour encadrer partiellement ou entierement une cellule en function de sa valeur (string)

Ce que je souhaites :

Si cellule="i" alors je veux juste la bordure de gauche
Si cellule= "l" alors bordure gauche et basse
"u" -> gauche, droite et basse
"o" -> les 4 bordures.

Pour l'instant j'ai ça :

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
 
Sub DoBordure()
 
 
 Dim r As Range 'Plage à parcourir
 Dim c As Range 'Cellule de la plage
 
 'Par exemple la sélection courante comme plage a traiter
 Set r = Selection
 
 For Each c In r
 
    If c.Font.Name = "Wingdings 1" & c = "i" Then
        c.Borders (xlEdgeLeft)
        c = ""
        Exit For
    End If
 
    If c.Font.Name = "Wingdings 1" & c = "l" Then
        c.Borders (xlEdgeLeft)
        c.Borders (xlEdgeBottom)
        c = ""
        Exit For
    End If
 
    If c.Font.Name = "Wingdings 1" & c = "u" Then
        c.Borders (xlEdgeLeft)
        c.Borders (xlEdgeBottom)
        c.Borders (xlEdgeRight)
        c = ""
        Exit For
    End If
 
    If c.Font.Name = "Wingdings 1" & c = "o" Then
        c.Borders (xlEdgeLeft)
        c.Borders (xlEdgeBottom)
        c.Borders (xlEdgeRight)
        c.Borders (xlEdgeTop)
        c = ""
        Exit For
    End If
 
 Next
 
End Sub

Il semblerait que la syntaxe "c.Borders (xlEdgeLeft)" ne fonctionne pas comme telle, quelqu'un aurait une idée?
Toutes autres remarques sont également bienvenues, car je débute encore..
Bonne journée

[jerome.vaussenat]

Salut,

dans un premier temps, il faut modifier tes lignes de test de cette manière

Code :

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

    If c.Font.Name = "Wingdings 1" And c.Value = "i" Then

Dans ton code, tu utilises le &. Sauf qu'en VBA, c'est un opérateur de concaténation et pas de cumul des conditions !

En espérant que cela te fera avancer.

[Menhir]

J'essai de faire une petite macro pour encadrer partiellement ou entierement une cellule en function de sa valeur (string)

Ce que je souhaites :

Si cellule="i" alors je veux juste la bordure de gauche
Si cellule= "l" alors bordure gauche et basse
"u" -> gauche, droite et basse
"o" -> les 4 bordures.

Pas besoin de faire du VBA pour ça.
Avec la mise en forme conditionnelle, ça se fait un moins de 5 min.

[anarchiste-mouton]

Bonjour Jerome et Menhir et merci pour vos réponses.

Effectivement la mise en forme conditionnelle permet de faire ça, mais impossible pour des bordures épaisses (que je souhaites maintenant).
De plus j'ai vraiment envie d'apprendre VBA donc je ne vois pas ça comme du temps de perdu.

Et comme vous allez le constater, il y a encore du boulot parce que j'ai pas réussi à faire sans la function (soi-disant diabolique) Goto :

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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
 
Sub DoBordure()
 
 Dim r As Range 'Plage à parcourir
 Dim c As Range 'Cellule de la plage
 
 'Par exemple la sélection courante comme plage a traiter
 Set r = Selection
 
 For Each c In r
 
    If c.Font.Name <> "Wingdings 1" Then
    GoTo laSortie
    End If
 
    If c = "" And c.Font.Name = "Wingdings 1" Then
    GoTo blanc
    End If
 
    If c = "i" And c.Font.Name = "Wingdings 1" Then
    GoTo inoir
    End If
 
    If c = "l" And c.Font.Name = "Wingdings 1" Then
    GoTo lnoir
    End If
 
    If c = "u" And c.Font.Name = "Wingdings 1" Then
    GoTo unoir
    End If
 
    If c = "o" And c.Font.Name = "Wingdings 1" Then
    GoTo onoir
    End If
 
    If c = "p" And c.Font.Name = "Wingdings 1" Then
    GoTo irouge
    End If
 
    If c = "pp" And c.Font.Name = "Wingdings 1" Then
    GoTo lrouge
    End If
 
    If c = "u" And c.Font.Name = "Wingdings 1" Then
    GoTo urouge
    End If
 
inoir::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
    GoTo laSortie
 
lnoir::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
    GoTo laSortie
 
unoir::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
    GoTo laSortie
 
onoir::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
    GoTo laSortie
 
blanc::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlDot
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With c.Borders(xlEdgeBottom)
            .LineStyle = xlDot
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With c.Borders(xlEdgeRight)
            .LineStyle = xlDot
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With c.Borders(xlEdgeTop)
            .LineStyle = xlDot
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    GoTo laSortie
 
irouge::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlDot
            .ColorIndex = 3
            .TintAndShade = 0
            .Weight = xlThick
        End With
    GoTo laSortie
 
lrouge::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeBottom)
            .LineStyle = xlDot
            .ColorIndex = 3
            .TintAndShade = 0
            .Weight = xlThick
        End With
    GoTo laSortie
 
urouge::
        With c.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With c.Borders(xlEdgeRight)
            .LineStyle = xlDot
            .ColorIndex = 3
            .TintAndShade = 0
            .Weight = xlThick
        End With
    GoTo laSortie
 
laSortie::
 
c = ""
 
Next
 
End Sub

Donc ça fait exactement ce que je veux mais le traitement est assez long si je selectionne beacoup de cellules.
Pensez vous qu'il soit possible de lancer cette macro à chaque fois que le contenu d'une cellule est modifié?

[unparia]

Bonjour
Déjà et surtout : depuis quand Goto retournerait-il quoi que ce soit ?

que j'ai pas réussi à faire sans la function (soi-disant diabolique) Goto

Goto n'est certes pas une fonction.

[halaster08]

Et comme vous allez le constater, il y a encore du boulot parce que j'ai pas réussi à faire sans la function (soi-disant diabolique) Goto :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
 For Each c In r
 If c.Font.Name = "Wingdings 1" Then
  select case c.value
     case ""
       'le code qui était dans ton GoTo
     case "i"
[...]
  end select
else
c=""
end if
next c

Pensez vous qu'il soit possible de lancer cette macro à chaque fois que le contenu d'une cellule est modifié?

Si tu veux déclencher la macro a chaque changement dans une cellule, il ne faut pas faire de boucle mais travailler uniquement sur la cellule en question.

[Menhir]

Effectivement la mise en forme conditionnelle permet de faire ça, mais impossible pour des bordures épaisses (que je souhaites maintenant).

Je ne vois vraiment pas pourquoi tu dis que c'est impossible.

Et comme vous allez le constater, il y a encore du boulot parce que j'ai pas réussi à faire sans la function (soi-disant diabolique) Goto :

L'instruction Goto, c'est l'idéal pour rendre un programme illisible et incompréhensible si on veut le reprendre quelques semaines après.
C'est sûr que, sur l'instant, ça permet de développer à toute vitesse (quoi que...) sans se poser de question. Mais ça fait des usines à gaz imbitables.

Dans ton cas, c'est extrêmement facile de s'en passer : il suffit que tu mettes la portion entre le label appelé et le la bel "LaSortie" dans la structure If à la place du Goto.
A noter qu'il serait d'ailleurs bienvenu de remplacer ces If successif par une structure Select Case.

[anarchiste-mouton]

Bonjour et merci à vous,

Pour les bordures épaisses (mise en forme conditionnelle), sauf erreur de ma part je ne peux pas les choisir, peut-être est-ce ma version 2013 qui veux ça?



Halaster, un grand merci à toi ! Cette syntaxe est effectivement plus comprehensible. Le traitement est meme plus rapide.

Concernant l'execution du sub DoBordure() à chaque changement de valeur d'une cellule de ma plage, j'ai adapté le code ci-dessous pour ma worksheet.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
 
    Set KeyCells = Range("F9:HD114")
 
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
 
               Call DoBordure
 
    End If
End Sub

J'ai aussi supprimé la boucle For du sub DoBordure () et ai collé ce dernier dans un module (voir ci-dessous).
Malheureusement il doit rester des erreurs car rien ne se passe après un changement de valeur d'une cellule comprise dans KeyCells...

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
Sub DoBordure()
 
 Dim c As Range 
 
 Set c = selection 
 
    If c.Font.Name = "Wingdings 1" Then
        Select Case c.Value
 
            Case ""
                 [instructions]
 
            Case "I"
               'etc...
      End select
   End If
End Sub

Bizzarement ça fonctionne en executant avec F8, mais le changement de valeur est detecté à la fin. Quelqu'un aurait une solution à proposer?

Merci d'avoir pris le temps de me lire et désolé si je ne suis pas très clair