Problème fonction Print #

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:

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

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].

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:

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

Code:

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