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
| Sub cartes()
Dim carte As Worksheet
Set carte = Worksheets("carte")
Dim donnees As Worksheet
Set donnees = Worksheets("données")
Dim code As String
'Dim pattern As String
Dim pays As Shape
Dim color As Long
Dim R(42) As Integer
Dim G(42) As Integer
Dim B(42) As Integer
'Dim Rp(42) As Integer
'Dim Gp(42) As Integer
'Dim Bp(42) As Integer
Dim z As Boolean
' vide les couleurs de la carte
limpacarta
'lit les couleurs
carte.Select
For k = 4 To 42
color = Cells(k, 2).Interior.color
R(k) = Int(color Mod 256)
G(k) = Int((color Mod 65536) / 256)
B(k) = Int(color / 65536)
'color = Cells(k, 2).Interior.PatternColor
'Rp(k) = Int(color Mod 256)
'Gp(k) = Int((color Mod 65536) / 256)
'Bp(k) = Int(color / 65536)
'pattern = Cells(k, 2).Interior.pattern
Next k
'lit l'année
For i = 4 To 11
If Cells(i, 7) <> "" Then u = i + 1
Next i
'lit la catégorie
For i = 4 To 10
If Cells(i, 10) <> "" Then v = Cells(i, 9)
Next i
'couleur pour chaque pays
For Each pays In carte.Shapes
'Récupérer le code du pays contenu dans le nom de l'objet
code = pays.Name
'aller chercher dans la colonne son nom
For i = 6 To donnees.UsedRange.Rows.Count
'Si la valeur de la cellule i dans la colonne de données 3 est égale
'au code lu dans la carte ET QUE la valeur de la cellule i dans la colonne de données 4
'est égale à v ALORS
If donnees.Cells(i, 3) = code And donnees.Cells(i, 4) = v Then
'And donnees.Cells(i, 3).Font.ColorIndex = 21 Then
'de k =4 à k=21
For k = 4 To 42
'Si les données de la cellule i (numéro de ligne) et u (année) est égale à la
'valeur de la cellule en ligne k colonne 3 ALORS
'If donnees.Cells(i, u) = carte.Cells(k, 3) Then
If carte.Cells(k, 3).Value Like "*&donnees.Cell(i,u)&*" Then
pays.Select
With Selection.ShapeRange.Fill
.ForeColor.RGB = RGB(R(k), G(k), B(k))
.Visible = msoTrue
.Solid
'.BackColor.RGB = RGB(Rp(k), Gp(k), Bp(k))
'.pattern = pattern
End With
z = False
End If
Next k
If z = True Then
With Selection.ShapeRange.Fill
.ForeColor.RGB = RGB(R(k), G(k), B(k))
.Visible = msoTrue
.Solid
'.BackColor.RGB = RGB(Rp(k), Gp(k), Bp(k))
'.pattern = pattern
End With
End If
End If
z = True
Next i
Next pays
End Sub
Sub limpacarta()
'tout pays en blanc
Dim carte As Worksheet
Set carte = Worksheets("carte")
carte.Select
For Each pays In carte.Shapes
pays.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Next pays
End Sub |
Partager