Sub Ecritcountry()
For Each c In [country]
If c <> "" Then ecritShape c, c
Next c
ecritShape "Spain", "Spain", "Haut"
ecritShape "Austria", "___Austria", "Bas"
ecritShape "Netherlands", "NL"
ecritShape "Belgium", "BG"
ecritShape "Czech Republic", "Czech R"
End Sub
Sub ecritShape(nomShape, Libellé, Optional posVert, Optional posHoriz)
On Error Resume Next
With Sheets("europe").Shapes(nomShape).TextFrame2.TextRange
.Characters.Text = Libellé
.Characters.Font.Size = 6
If IsMissing(posVert) Then
.Parent.VerticalAnchor = msoAnchorMiddle
Else
If posVert = "Bas" Then
.Parent.VerticalAnchor = msoAnchorBottom
Else
If posVert = "Haut" Then
.Parent.VerticalAnchor = msoAnchorTop
Else
.Parent.VerticalAnchor = msoAnchorMiddle
End If
End If
End If
If IsMissing(posHoriz) Then
.Parent.HorizontalAnchor = msoAnchorCenter
Else
If posHoriz = "Gauche" Then
.Parent.HorizontalAnchor = msoAnchorNone
Else
.Parent.HorizontalAnchor = msoAnchorCenter
End If
End If
End With
End Sub
Sub ListShapes()
i = 2
For Each s In Sheets("europe").Shapes
Cells(i, "k") = s.Name
i = i + 1
Next s
End Sub
Sub supShapes()
For Each s In ActiveSheet.Shapes
If s.Name Like "*Freef*" Then s.Delete
Next s
End Sub