Construire une Boucle
Tang2208
Messages postés
1
Statut
Membre
-
pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention -
pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention -
Bonjour,
Je voudrais colorier un carte du monde en fonction du nom du Pays et de si le pays est associé à la lettre "x". J'ai réussi avec le code suivant pour deux pays. Mais je voudrais le faire avec une boucle : tant que la case Pays n'est pas vide faire ... puis passe a la cellule d'en dessous.
J'ai essayer pour la boucle avec le VBA suivant mais ca ne focntionne pas :
Merci d'avance pour votre Aide !!!
Je voudrais colorier un carte du monde en fonction du nom du Pays et de si le pays est associé à la lettre "x". J'ai réussi avec le code suivant pour deux pays. Mais je voudrais le faire avec une boucle : tant que la case Pays n'est pas vide faire ... puis passe a la cellule d'en dessous.
Sub Colorier()
'
' Macro1 Macro
'
If Range("O8") = "x" Then
ActiveSheet.Shapes("France").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Else
ActiveSheet.Shapes("France").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 255, 255)
.TintAndShade = 0
End With
End If
If Range("O9") = "x" Then
ActiveSheet.Shapes("Germany").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Else
ActiveSheet.Shapes("Germany").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 255, 255)
.TintAndShade = 0
End With
End If
End sub
J'ai essayer pour la boucle avec le VBA suivant mais ca ne focntionne pas :
Sub Boucle()
Dim i As Integer
i = 8
Dim Pays As String
Pays = Range("N" & i).Value
Do While Range("N" & i) <> "" 'Faire la boucle tant que la cellule sélectionée n'est pas vide
If Range("O" & i) = "x" Then
ActiveSheet.Shapes(Pays).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Else
ActiveSheet.Shapes(Pays).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 255, 255)
.TintAndShade = 0
End With
End If
i = i + 1 'Décalage de 1 ligne à chaque fois
Loop
End Sub
Merci d'avance pour votre Aide !!!
1 réponse
-
Bonjour,
Tout d'abord, lorsque vous placez du code sur notre forum, merci d'utiliser les balises code à votre disposition.
Le mode d'emploi (au cas ou) est ICI.
Ensuite, dire « Ça ne marche pas » ou « Il y a une erreur », cela n'avance en rien.
Donnez le comportement observé et/ou le message d'erreur !
Et pour finir, vous donnez une valeur initiale à votre variable Pays :Pays = Range("N" & i).Value, valeur que vous ne changez jamais dans votre boucle...
Donc :Sub Boucle() Dim i As Integer i = 8 Dim Pays As String Do While Range("N" & i) <> "" 'Faire la boucle tant que la cellule sélectionnée n'est pas vide Pays = Range("N" & i).Value If Range("O" & i) = "x" Then ActiveSheet.Shapes(Pays).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Else ActiveSheet.Shapes(Pays).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = RGB(255, 255, 255) .TintAndShade = 0 End With End If i = i + 1 'Décalage de 1 ligne à chaque fois Loop End Sub
