[XL-2007] [VBA] Cellule trop courte, generation d'objet vectoriel

[therabbitkiller]

Bonjour,

Je me tourne vers vous car je seche completement ! J'essaye de créer un fond de carte à l'aide d'un fichier svg depuis excel (le plus simple dans office) à l'aide du script suivant :

Code :

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
Option Explicit
 
'---------------------------------------------------------------------------------------------------------
' Importation du fichier SVG des départements et création des formes libres
'---------------------------------------------------------------------------------------------------------
' Utilisation des valeurs de la feuille Departements
'---------------------------------------------------------------------------------------------------------
Function CreateShapes()
Dim oSheet As Excel.Worksheet ' Feuille de travail
Dim lLine As Long ' Compteur de lignes
Dim lCoord As String ' Coordonnées du département
Dim lCoordArray As Variant ' Coordonnées du département 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
 
' Feuille de données
Set oSheet = Sheets("Commune")
' Parcours la feuille des données
For lLine = 1 To 10
    ' Coordonnées
    lCoord = oSheet.Cells(lLine, 1)
    ' Mise en forme des coordonnées
    lCoord = Replace(lCoord, "M", "M ")
    lCoord = Replace(lCoord, "L", " L ")
    'lCoord = Replace(lCoord, "Z", " Z")
    lCoord = Replace(lCoord, "C", "C ")
    ' 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 le département courant sur la feuille oSheet
                Set loFreeformBuilder = oSheet.Shapes.BuildFreeform(msoEditingCorner, Val(lCoordArray(lCptCoord + 1)) * 10, Val(lCoordArray(lCptCoord + 2)) * 10)
                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
                ' Converti le Constructeur en Forme
                With loFreeformBuilder.ConvertToShape
                    ' Identifiant du département
                    .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 départements dans une forme
'With oSheet.Shapes.Range(lShapeRange).Group
    '.Name = "CarteFrance"
    '.ScaleHeight 0.05, msoFalse
    '.ScaleWidth 0.05, msoFalse
    '.LockAspectRatio = msoTrue
End With
End Function

Le probleme est le suivant le code fonctionne très bien pour un nombre limité de point par exemple (qqu seconde pour générer l'objet grand max) :

Code :

M2.237 3.579 C2.237 3.579 0 3.579 0 3.579 C0 3.579 0 0 0 0 C0 0 0.474 0 0.474 0 C0.474 0 0.474 3.157 0.474 3.157 C0.474 3.157 2.237 3.157 2.237 3.157 C2.237 3.157 2.237 3.579 2.237 3.579 Z

Mais excel plante complétement avec des formes plus complexes comme

Code :

M1546.8 1209.37L1546.86 1209.19L1547.82 1208.83L1548.66 1208.95L1549.2 1209.31L1549.62 1210.09L1549.98 1211.41L1550.52 1212.19L1551.42 1212.85L1552.2 1213.15L1554.84 1213.33L1556.52 1213.81L1557.84 1214.59L1558.68 1215.37L1559.34 1216.93L1560.54 1218.43L1560.66 1218.61L1561.5 1218.43L1562.1 1218.25L1564.68 1219.99L1565.64 1220.35L1566.24 1220.89L1568.82 1222.09L1570.44 1222.63L1571.22 1222.93L1571.76 1223.47L1571.88 1223.83L1571.88 1225.27L1571.64 1226.47L1571.64 1227.91L1572.18 1229.95L1573.02 1231.93L1574.22 1234.27L1574.22 1234.33L1574.4 1234.99L1575.48 1236.01L1577.4 1237.57L1578.72 1238.35L1579.86 1239.25L1581.66 1240.99L1583.58 1243.09L1584 1243.27L1584.66 1243.39L1585.98 1243.75L1586.7 1244.29L1587.42 1245.31L1587.9 1245.85L1588.02 1245.91L1589.64 1247.53L1590.42 1247.77L1590.84 1247.77L1591.2 1247.05L1591.38 1246.81L1591.5 1246.27L1591.98 1245.43L1592.4 1244.77L1592.88 1243.81L1593.42 1242.55L1594.74 1241.17L1595.58 1240.81L1596 1240.15L1597.14 1239.61L1598.28 1238.65L1598.94 1237.75L1599.06 1237.63L1599 1237.27L1598.04 1235.83L1597.98 1235.17L1597.62 1234.69L1596.9 1234.03L1596.54 1233.43L1596.18 1232.71L1596 1231.93L1596.36 1230.97L1596.78 1230.67L1597.08 1230.49L1597.44 1230.43L1597.86 1230.49L1599.66 1231.03L1600.44 1231.21L1601.22 1231.09L1601.82 1230.85L1602.66 1229.83L1603.14 1229.29L1605.42 1228.09L1605.9 1227.73L1606.5 1227.13L1606.68 1226.65L1606.74 1225.99L1605.36 1225.21L1605.36 1223.71L1605.6 1222.81L1605.72 1222.57L1607.52 1222.57L1608.3 1222.45L1611.72 1220.11L1612.56 1219.51L1612.74 1219.51L1613.64 1218.73L1614.3 1218.31L1614.78 1218.07L1616.64 1217.11L1619.82 1215.07L1621.56 1213.81L1623.36 1212.37L1625.1 1211.11L1625.94 1210.21L1626.6 1209.37L1627.26 1208.71L1628.1 1207.39L1628.1 1207.33L1628.4 1206.91L1628.34 1206.43L1628.52 1205.83L1628.82 1204.81L1629.24 1203.37L1629.9 1201.33L1630.98 1198.27L1630.98 1198.09L1631.1 1197.91L1631.82 1195.87L1632 1194.67L1632.24 1191.85L1632.18 1191.55L1631.52 1190.53L1631.58 1190.05L1631.7 1189.45L1630.5 1188.37L1629.48 1187.83L1629.42 1187.83L1627.2 1186.33L1626.66 1186.63L1626.54 1186.63L1626.18 1186.45L1625.64 1186.15L1625.7 1185.73L1625.7 1185.25L1625.16 1184.71L1624.56 1185.31L1624.32 1185.61L1623 1185.37L1622.46 1185.13L1621.44 1184.53L1621.02 1183.57L1620.3 1181.41L1620.3 1180.87L1620.54 1180.45L1620.54 1179.31L1621.08 1178.53L1621.32 1177.57L1621.62 1176.79L1623 1174.87L1623.42 1174.15L1623.72 1173.55L1623.84 1172.95L1623.9 1171.63L1624.02 1170.73L1624.2 1170.25L1623.66 1169.95L1623.24 1169.89L1622.1 1169.83L1621.86 1169.41L1621.68 1169.11L1620.84 1168.87L1617.36 1167.61L1614.9 1166.41L1614 1167.73L1612.08 1167.25L1609.26 1166.59L1608.18 1166.05L1607.7 1165.93L1606.92 1167.07L1605.84 1168.15L1605.48 1168.15L1604.76 1167.55L1603.08 1165.87L1602.6 1165.33L1600.74 1163.71L1600.02 1163.05L1599.78 1162.93L1597.02 1164.61L1596.36 1164.91L1596.24 1165.33L1595.76 1166.53L1595.58 1167.73L1595.58 1168.87L1595.7 1169.77L1592.76 1169.41L1591.26 1169.35L1590.42 1169.53L1590.42 1170.79L1590.24 1171.27L1589.88 1171.81L1587.54 1173.07L1587.3 1173.37L1587.12 1173.91L1586.76 1174.39L1586.28 1174.87L1584.66 1176.43L1583.82 1177.15L1583.1 1178.35L1582.86 1178.95L1582.32 1180.45L1582.02 1181.29L1581.66 1182.13L1581.18 1182.91L1581.54 1183.21L1581.54 1183.63L1581.24 1184.71L1581.06 1185.85L1580.82 1185.97L1580.64 1185.97L1580.1 1185.25L1579.92 1185.25L1579.62 1185.55L1578.48 1185.73L1577.52 1186.93L1577.58 1187.11L1578.72 1188.25L1576.86 1188.25L1576.02 1187.65L1575.6 1187.47L1575.54 1187.89L1575.84 1188.01L1575.9 1188.19L1575.72 1188.73L1576.02 1188.97L1576.02 1189.57L1574.28 1189.57L1573.68 1189.45L1573.32 1189.45L1572.72 1190.11L1571.64 1191.85L1571.22 1192.87L1571.1 1193.83L1570.38 1193.83L1569.96 1193.65L1569.42 1193.59L1567.2 1194.49L1566.36 1194.49L1565.94 1194.25L1565.52 1193.29L1558.86 1192.69L1558.62 1192.81L1557.36 1193.77L1556.28 1194.25L1554.66 1194.61L1553.64 1195.09L1552.92 1195.51L1551.78 1195.75L1551.36 1195.27L1551 1194.49L1550.58 1192.51L1550.28 1191.73L1549.5 1190.59L1549.44 1189.75L1549.32 1189.09L1549.08 1188.79L1548.66 1187.53L1548.24 1187.05L1547.94 1186.57L1547.28 1186.15L1546.8 1186.09L1546.8 1186.39L1545.3 1186.27L1544.88 1186.09L1544.04 1184.83L1543.5 1184.47L1542.78 1183.57L1542.06 1182.37L1541.28 1182.25L1540.86 1179.19L1540.26 1177.33L1539.78 1176.61L1539.06 1176.31L1538.64 1176.01L1537.44 1175.17L1529.34 1168.21L1529.1 1167.97L1528.68 1167.73L1528.74 1169.29L1528.56 1170.67L1527.96 1172.11L1528.92 1174.09L1529.22 1175.17L1529.34 1178.35L1529.64 1179.43L1530.48 1181.35L1530.48 1182.07L1530.24 1183.03L1530.18 1184.05L1530.36 1185.49L1530.36 1186.63L1530 1187.29L1529.58 1188.13L1529.28 1188.85L1528.74 1189.09L1526.7 1189.45L1522.98 1190.05L1522.02 1190.35L1522.2 1191.13L1522.26 1191.67L1522.08 1192.69L1521.78 1193.83L1520.76 1194.61L1520.46 1195.03L1518.96 1196.23L1517.82 1198.03L1517.76 1198.57L1518.66 1201.27L1518.78 1204.51L1521.9 1206.01L1523.22 1207.39L1523.64 1207.81L1523.94 1208.23L1525.68 1209.55L1528.32 1210.57L1529.16 1210.51L1530 1210.09L1530.54 1210.15L1534.5 1212.43L1535.28 1212.85L1535.76 1212.85L1536.66 1212.25L1540.2 1210.39L1541.94 1208.95L1544.88 1210.63L1545.12 1210.63L1546.8 1209.37Z

D'ou peut provenir ce bug ? Merci à tous
nico

[Daranc]

si excel n'y comprends rien que te dire de moi ?
j'ai juste remarqué une chose
dans la première série
tu as des nombres xxxxx.xx nnn.nn séparé par un espace
dans la deuxieme les espaces sépare des données comportant deux points
xxxx.xx.xx nn.nn.nn
j'ignore si c'est normal je fait juste une constatation