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
| Option Explicit
'---------------------------------------------------------------------------------------------------------
' Importation du fichier SVG des communes et création des formes libres
'---------------------------------------------------------------------------------------------------------
Function CreateShapes()
Dim oSheet As Excel.Worksheet ' Feuille de travail
Dim NbLignes As Integer ' Nombre total de lignes à traiter
Dim lLine As Long ' Compteur de lignes
Dim lCoord As String ' Coordonnées de la commune
Dim lCoordArray As Variant ' Coordonnées de la commune en tableau
Dim lCptCoord As Long ' Compteur pour parcourir les coordonnées
Dim lNbShape As Long ' Nombre de formes créées
Dim lShapeRange() ' Tableaux des noms de formes créées pour fonction Group
Dim loFreeformBuilder As Excel.FreeformBuilder 'Constructeur de forme libre
Dim lFirstX As Double, lFirstY As Double 'Fermeture de la forme libre
' Feuille de données
Set oSheet = ActiveSheet
'comptage du nombre de lignes sur cette feuille
NbLignes = oSheet.UsedRange.Rows.Count
' Parcourt la feuille des données
For lLine = 1 To NbLignes
' Coordonnées
lCoord = oSheet.Cells(lLine, 1)
' Mise en forme des coordonnées
lCoord = Replace(lCoord, ",", " ")
' Crée un tableau à partir de la chaîne de caractères
lCoordArray = Split(lCoord, " ")
' Initialise le compteur
lCptCoord = LBound(lCoordArray)
Do
Select Case lCoordArray(lCptCoord)
Case "M" ' Point de départ
' Crée un constructeur de "forme libre" pour la commune courante sur la feuille oSheet
Set loFreeformBuilder = oSheet.Shapes.BuildFreeform(msoEditingCorner, Val(lCoordArray(lCptCoord + 1)) * 10, Val(lCoordArray(lCptCoord + 2)) * 10)
' Garde la position du premier point
lFirstX = Val(lCoordArray(lCptCoord + 1))
lFirstY = Val(lCoordArray(lCptCoord + 2))
lCptCoord = lCptCoord + 3
Case "L" ' Segment
loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, Val(lCoordArray(lCptCoord + 1)) * 10, Val(lCoordArray(lCptCoord + 2)) * 10
lCptCoord = lCptCoord + 3
Case "C" ' Courbe
loFreeformBuilder.AddNodes msoSegmentCurve, msoEditingCorner, _
Val(lCoordArray(lCptCoord + 1)) * 10, Val(lCoordArray(lCptCoord + 2)) * 10, Val(lCoordArray(lCptCoord + 3)) * 10, Val(lCoordArray(lCptCoord + 4)) * 10, Val(lCoordArray(lCptCoord + 5)) * 10, Val(lCoordArray(lCptCoord + 6)) * 10
lCptCoord = lCptCoord + 7
Case "z" ' Fin de la forme
' Ferme la forme
loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, lFirstX * 10, lFirstY * 10
lCptCoord = lCptCoord + 3
' Convertit le Constructeur en Forme
With loFreeformBuilder.ConvertToShape
' Identifiant de la commune
.Name = oSheet.Cells(lLine, 2)
' Incrémente le nombre de formes créées
lNbShape = lNbShape + 1
' Redimensionne le tableau de formes créées
ReDim Preserve lShapeRange(1 To lNbShape)
' Ajoute le nom de la forme au tableau pour groupement
lShapeRange(lNbShape) = .Name
End With
' Libère l'objet constructeur
Set loFreeformBuilder = Nothing
' Sort de la boucle de traitement des coordonnées
Exit Do
End Select
Loop
Next
' Groupe les communes dans une forme
With oSheet.Shapes.Range(lShapeRange).Group
.Name = "CarteBasRhin"
.ScaleHeight 0.05, msoFalse
.ScaleWidth 0.05, msoFalse
.LockAspectRatio = msoTrue
End With
End Function |
Partager