Construire une Boucle

Tang2208 Messages postés 1 Date d'inscription Statut Membre Dernière intervention -
pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention - 7 oct. 2014 à 11:16

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.

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 !!!

Afficher la suite

A voir également:

Construire une Boucle
Jeux pour construire des maisons en 3d gratuit - Télécharger - Architecture & Déco
Construire un organigramme - Guide
Boucle excel sans macro - Forum Excel
Mon pc s'allume et s'éteint en boucle ✓ - Forum Matériel & Système
Mise à disposition de boucle locale dédiée ✓ - Forum Freebox

1 réponse

Réponse 1 / 1

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

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

Discussions similaires

Mon pc s'allume et s'éteint en boucle

Mon ordinateur s'allume et s'eteint en boucle

tele s'eteind et s'allume en boucle

problème tv décodeur orange

Redmi redémarre en boucle - Fastboost impossible

Votre réponse

Discussions similaires