Discussion :

[Patoche07]

Bonjour,
Je souhaite écrire un fichier KML par rapport à un tableau dans mon excel
Le problème est que j'utilise la fonction Print et celle-ci ne veut pas écrire toutes les lignes que je lui demande.
Elle s'arrête toujours à la même et saute directement à la fin du programme.

Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
81
82
83
84
85
86
87
88
89
Sub convertir()

Dim Cible As Integer, x As Integer, y As Integer, z As Integer
Dim Resultat As String
Dim doc As String
Dim Cell As Range
 
'Définit le nombre de point
Call der
x = Sheets("Feuil1").Range("$K$5")
 doc = InputBox(" Saisir l'emplacement du FICHIER: " & Chr(10) & " Exemple : F:\test.kml")
   
Cible = FreeFile

Open doc For Append As #Cible
    Print #Cible, "<?xml version='1.0' encoding='UTF-8'?>"
    Print #Cible, "<kml xmlns='http://www.opengis.net/kml/2.2'>"
    Print #Cible, "        <Document>"
    Print #Cible, "                <name>Calque sans titre</name>"
For x = 1 To Feuil1.Range("K5")
    Print #Cible, "                <Placemark>"
    Print #Cible, "                        <name>Point" & Sheets("Feuil4").Range("A" & x) & "</name>"
    Print #Cible, "                        <styleUrl>#icon-503-DB4436-nodesc</styleUrl>"
    Print #Cible, "                        <ExtendedData>"
    Print #Cible, "                        </ExtendedData>"
    Print #Cible, "                        <Point>"
    Print #Cible, "                                <coordinates>" & Sheets("Feuil4").Range("B" & x) & "</coordinates>"
    Print #Cible, "                        </Point>"
    Print #Cible, "                </Placemark>"
 Next x
 For z = 1 To 1
    Print #Cible, "                <Placemark>"
    Print #Cible, "                        <name>Point" & Sheets("Feuil1").Range("L5") & "</name>"
    Print #Cible, "                        <styleUrl>#icon-503-DB4436-nodesc</styleUrl>"
    Print #Cible, "                        <ExtendedData>"
    Print #Cible, "                        </ExtendedData>"
    Print #Cible, "                        <Point>"
    Print #Cible, "                                <coordinates>" & Sheets("Feuil4").Range("D4") & "," & Sheets("Feuil4").Range("E4") & "," & "0.0</coordinates>"
    Print #Cible, "                        </Point>"
    Print #Cible, "                </Placemark>"
    Print #Cible, "                <Style id='icon-503-DB4436-nodesc-normal'>"
    Print #Cible, "                        <IconStyle>"
    Print #Cible, "                                <color>ff3644DB</color>"
    Print #Cible, "                                <scale>1.1</scale>"
    Print #Cible, "                                <Icon>"
    Print #Cible, "                                        <href>http://www.gstatic.com/mapspro/images/stock/503-wht-blank_maps.png</href>"
    Print #Cible, "                                </Icon>"
    Print #Cible, "                                <hotSpot x='16' y='31' xunits='pixels' yunits='insetPixels'>"
    Print #Cible, "                                </hotSpot>"
    Print #Cible, "                        </IconStyle>"
    Print #Cible, "                        <LabelStyle>"
    Print #Cible, "                                <scale>0.0</scale>"
    Print #Cible, "                        </LabelStyle>"
    Print #Cible, "                        <BalloonStyle>"
    Print #Cible, "                                <text><![CDATA[<h3>$[name]</h3>]]></text>"
    Print #Cible, "                        </BalloonStyle>"
    Print #Cible, "                </Style>"
    Print #Cible, "                <Style id='icon-503-DB4436-nodesc-highlight'>"
    Print #Cible, "                        <IconStyle>"
    Print #Cible, "                                <color>ff3644DB</color>"
    Print #Cible, "                                <scale>1.1</scale>"
    Print #Cible, "                                <Icon>"
    Print #Cible, "                                        <href>http://www.gstatic.com/mapspro/images/stock/503-wht-blank_maps.png</href>"
    Print #Cible, "                                </Icon>"
    Print #Cible, "                                <hotSpot x='16' y='31' xunits='pixels' yunits='insetPixels'>"
    Print #Cible, "                                </hotSpot>"
    Print #Cible, "                        </IconStyle>"
    Print #Cible, "                        <LabelStyle>"
    Print #Cible, "                                <scale>1.1</scale>"
    Print #Cible, "                        </LabelStyle>"
    Print #Cible, "                        <BalloonStyle>"
    Print #Cible, "                                <text><![CDATA[<h3>$[name]</h3>]]></text>"
    Print #Cible, "                        </BalloonStyle>"
    Print #Cible, "                </Style>"
    Print #Cible, "                <StyleMap id='icon-503-DB4436-nodesc'>"
    Print #Cible, "                        <Pair>"
    Print #Cible, "                                <key>normal</key>"
    Print #Cible, "                                <styleUrl>#icon-503-DB4436-nodesc-normal</styleUrl>"
    Print #Cible, "                        </Pair>"
    Print #Cible, "                        <Pair>"
    Print #Cible, "                                <key>highlight</key>"
    Print #Cible, "                                <styleUrl>#icon-503-DB4436-nodesc-highlight</styleUrl>"
    Print #Cible, "                        </Pair>"
    Print #Cible, "                </StyleMap>"
    Print #Cible, "        </Document>"
    Print #Cible, "</kml>"
Next
MsgBox "termine"
End Sub

Elle m'affiche "terminé" en fin de lancement de macro mais lorsque j'ouvre le kml il me manque toujours la partie en Rouge.

Comment dois-je procéder, je suis désespéré.

Cordialement

[Invité]

Bonjour,
Tu place ton curseur en ligne 80, tu appuis sur la touche [F9], tu exécute t'a macro et quand le programme s'arrête tu fais [F8].

[Patoche07]

Bonjour,
J'ai trouvé, j'oublié de mettre close #Cible à la fin, en le mettant tout se passe très bien.

Un grand Merci !!!

J'ai une autre petite question
Je souhaite enregistrer le fichier sur mon Bureau.
Et je passe par un INPutBox Mais si je clic sur annuler il m'affiche le débogage.
En ajoutant le un error go to cela m'affiche erreur lorsque je rentre quequechose dans le InPutBox
Je souhaite remplacer par ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Dim i As Single
Dim count As Single
Dim Repertoire As String
Dim NomFichier As String
Dim sNomFichier As String
Dim iFile As Integer
Dim str As String
Dim dateformat As String
Dim sdateformat As String
Dim Obj As Object
Dim StrObj As String
 
'Affiche le userform d'enregistrement
UserForm3.Show
 
'gère le chemin d'enregistrement et le nom du fichier
Set Obj = CreateObject("WScript.Shell")
StrObj = Obj.SpecialFolders("Desktop")
Repertoire = StrObj & "\"
NomFichier = NomTap
sNomFichier = NomFichier & ".kml"
 
'imprime sur un bloc note les differentes lignes
On Error Resume Next
iFile = FreeFile
Open Repertoire & sNomFichier For Output As #iFile

Cependant quand j'entre le message dans ma textbox après une fois enregistrer il a pas de nom ...
Avez-vous une idée de où ça peut provenir ?

Merci

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ficher=INPutBox
If fichier ="" then exit sub