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
|
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
' 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 |
Problème pour la création d'une carte sous Excel
Répondre avec citation
)
Envoyé par SkyCorp
Partager