Private Sub Workbook_Open()
Dim s As Shape
For Each s In Feuil1.Shapes 'CodeName de la feuille
s.OnAction = "Feuil1.Click_France"
Next
End Sub
Job75 à dit:avec la macro Click_France
Private Sub Workbook_Open()
Dim s As Shape
Application.ScreenUpdating = False
For Each s In Feuil1.Shapes 'CodeName de la feuille
s.OnAction = "Feuil1.Click_France"
s.Fill.Transparency = 1
Next
End Sub
Sub Click_France()
With Shapes.Range(Array("Alpes Maritimes", "Var", "Bouches Du Rhone", "Alpes de Haute Provence", "Hautes Alpes", "Drome", "Isere")).Fill
.Transparency = IIf(.Transparency, 0, 1)
End With
End Sub
Sub Click_France()
Dim s As Shape
Application.ScreenUpdating = False
For Each s In Shapes
If s.Fill.ForeColor.RGB Then _
s.Fill.Transparency = IIf(s.Fill.Transparency, 0, 1)
Next
End Sub
Sub Click_France()
Dim s As Shape
For Each s In Shapes
If s.Fill.ForeColor.RGB Then _
s.Fill.Transparency = IIf(s.Fill.Transparency, 0, 1)
Next
End Sub