Discussion :

[logan138]

Bonjour a tous,
Voila je travaille a creer un "base de donnée" pour une asso qui servira notament a faire des mailling list.
J'ai reussi a adapter des macro que j'ai trouvé a droite et à gauche sur le net pour que la liste des mail soit compacter dans une seul cellule et que cette liste tienne compte des tri effectué dans les différentes classe de la base de donnée.
Par contre ce que je souhaiterais, c'est creer un bouton sur la feuille du classeur excel pour que lorsqu'on clic dessus, un fichier txt contenant la liste des mails compacté soit générer.
Et la, je bloque car je ne sais pas comment lier une macro a un bouton mais surtout, je n'ai trouvé aucune macro sur le net qui fasse ça.
Est ce faisable? Si oui pourriez vous m'aider?
Pourriez vous également m'expliquer comme lier une macro et un bouton.
je vous remercie d'avance
Logan

ps : voici mon excel
https://dl.dropbox.com/s/tvzz9tmg2cc...08-12.xls?dl=1

[Godzestla]

Bonjour;
Juste une petite remarque en passant : publier la liste d'emails non factices est une source de spam très importante.

Tu devrais nettoyer ton excel de toutes données réelles.

Pour le reste, en cherchant dans les tutos ou dans la FAQ, tu devrais trouver sans peine.

[logan138]

ha ok
je vais regarder la partie tutos et FAQ
un en particulier en tête???

[Qwazerty]

Salut
Je n'ai pas regardé ton fichier, mais voila un exemple de manipulation de fichier texte externe

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
Sub NMEA_Convert()
 
Dim PathSource As String, PathDest As String
Dim FileNumS As Integer, FileNumD As Integer
Dim TmpStr As String
 
'Recupere le chemin du fichier au format 1 (NMEA)
PathSource = Application.GetOpenFilename(FileFilter:="(*.txt),*.txt", Title:="Sélectionnez le fichier NMEA à convertir")
If PathSource = "Faux" Then Exit Sub 'si pas de sélection faite on quite
 
'On demande a l'utilisateu ou il souhaite enregistrer ce nouveau fichier
PathDest = Application.GetSaveAsFilename(PathSource, FileFilter:="(*.txt),*.txt", Title:="Créer le fichier de destination")
If PathDest = "Faux" Then Exit Sub 'l'utilisateur a annulé l'opération
 
'On verifie que la source est la destination ne sont pas identique
If PathSource = PathDest Then Exit Sub
 
'Ouvrir le fichier Source
FileNumS = FreeFile
Open PathSource For Input As #FileNumS
 
'Ouvrir/Créer fichier Destination
FileNumD = FreeFile
Open PathDest For Output As #FileNumD
 
'Initialisation
DeltaT = 0
'minDeltaT = CDate("00:01:00")
'minDeltaT = CDate("00:" & combobox1.Text & ":00") 'pas testé mais ce doit etre ça
minDeltaT = 1
'minDeltatT = CInt(TaUserForm.combobox1.Text)
 
'On ignore la 1ere ligne
Line Input #FileNumS, TmpStr
 
'lire le fichier Source
Do Until EOF(FileNumS)
    Line Input #FileNumS, TmpStr
    TmpStr = ConvertToFormat2(TmpStr)
    'Inscrire dans le fichier Destination
    If TmpStr <> "" Then Print #FileNumD, TmpStr
 
Loop
 
'On ferme les 2 fichiers
Close #FileNumS
Close #FileNumD
 
 
End Sub

++
Qwaz

[logan138]

merci pour ton aide
j'ai c/c ta macro et je l'ai testé mais il semble que quelque chose bloque et je suis incapable de voir quoi.
Je selection la case que je veux exporter vers un txt mais lorsque je clique sur le bouton pour executer la macro, il me dit :

J'ai essayé de comprendre ce que fait la macro mais pareil, je suis pas sur de tout comprendre.

comme on me l'avais suggérer, j'ai reheberger le fichier avec des email factice
le voila.

[Qwazerty]

Salut
Le code que je t'ai donné n'a pas pour but d’être exécuté en faite, je pourrais te passer le reste du fichier si tu le souhaites, mais le but était uniquement que tu récupère à l’intérieur les morceaux de code qui gère le fichier. C'est pour cela que le code est commenté. Essai de piocher ce dont tu as besoin, si tu n'y arrive pas je t'aiderais un peu plus tard dans la soirée.

++
Qwaz

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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
Option Explicit
Private DeltaT As Date
Private minDeltaT As Integer
 
Sub NMEA_Convert()
 
Dim PathSource As String, PathDest As String
Dim FileNumS As Integer, FileNumD As Integer
Dim TmpStr As String
 
'Recupere le chemin du fichier au format 1 (NMEA)
PathSource = Application.GetOpenFilename(FileFilter:="(*.txt),*.txt", Title:="Sélectionnez le fichier NMEA à convertir")
If PathSource = "Faux" Then Exit Sub 'si pas de sélection faite on quite
 
'On demande a l'utilisateu ou il souhaite enregistrer ce nouveau fichier
PathDest = Application.GetSaveAsFilename(PathSource, FileFilter:="(*.txt),*.txt", Title:="Créer le fichier de destination")
If PathDest = "Faux" Then Exit Sub 'l'utilisateur a annulé l'opération
 
'On verifie que la source est la destination ne sont pas identique
If PathSource = PathDest Then Exit Sub
 
'Ouvrir le fichier Source
FileNumS = FreeFile
Open PathSource For Input As #FileNumS
 
'Ouvrir/Créer fichier Destination
FileNumD = FreeFile
Open PathDest For Output As #FileNumD
 
'Initialisation
DeltaT = 0
'minDeltaT = CDate("00:01:00")
'minDeltaT = CDate("00:" & combobox1.Text & ":00") 'pas testé mais ce doit etre ça
minDeltaT = 1
'minDeltatT = CInt(TaUserForm.combobox1.Text)
 
'On ignore la 1ere ligne
Line Input #FileNumS, TmpStr
 
'lire le fichier Source
Do Until EOF(FileNumS)
    Line Input #FileNumS, TmpStr
    TmpStr = ConvertToFormat2(TmpStr)
    'Inscrire dans le fichier Destination
    If TmpStr <> "" Then Print #FileNumD, TmpStr
 
Loop
 
'On ferme les 2 fichiers
Close #FileNumS
Close #FileNumD
 
 
End Sub
 
Function ConvertToFormat2(NMEAChaine As String) As String
'976 XX°42'472 N - YYY°49'046 E  25/02/2010 18:26:42 11.5 kn 209.5°  10.5 kn 211.0° 'NMEA
Dim Tab_Infos
Dim aDate As Date
 
'On sépart les infos
Tab_Infos = Split(NMEAChaine, Chr(9))
 
'On arrondi l'horraire a la minute
aDate = CDate(Tab_Infos(2))
'aDate = Int(aDate) + CDbl(CDate(CStr(Hour(aDate)) & ":" & CStr(Minute(aDate))))
 
'On controle que la durée ecoulé avec la mesure precedente
'If (DeltaT <> 0) And (CDate(aDate - DeltaT) < minDeltaT) Then
If (DeltaT <> 0) And (DateDiff("n", DeltaT, aDate) < minDeltaT) Then
    'Si le laps de temps est trop court, on renvoie une chaine vide
    ConvertToFormat2 = ""
    Exit Function
End If
 
DeltaT = aDate
'On met en forme les infos 'XX°48'357 N - YYY°53'514 E
'Phi-G
Tab_Infos(1) = Replace(Tab_Infos(1), "°", "") 'on supprime les °
Tab_Infos(1) = Replace(Tab_Infos(1), "'", ".") 'on remplace ' par .
Tab_Infos(1) = Replace(Tab_Infos(1), " ", "") 'on supprime les espaces
'FFFF.FFFS-GGGGG.GGGW
Tab_Infos(1) = Left(Tab_Infos(1), 6) & Mid(Tab_Infos(1), 9, 2) & Mid(Tab_Infos(1), 11, 7) & Right(Tab_Infos(1), 1)
'Vit
Tab_Infos(3) = Left(Tab_Infos(3), InStr(1, Tab_Infos(3), ".") + 1) 'les caractere avant le . + 1 caractere apres, convertie en nombre puis mis sur un format a 2 caracteres 01, 02 , ...
If IsNumeric(Tab_Infos(3)) Then
    Tab_Infos(3) = CDbl(Tab_Infos(3))
Else
    Tab_Infos(3) = Val(Tab_Infos(3))
End If
Tab_Infos(3) = Format(Round(Tab_Infos(3)), "0#")
 
'ROut
Tab_Infos(4) = Replace(Tab_Infos(4), ".", "") 'supprime les .
Tab_Infos(4) = Left(Tab_Infos(4), 3)
 
'On recompose en format2
ConvertToFormat2 = "TRACK/" & Format(aDate, "ddhhnn") & "/" & Tab_Infos(1) & "/" & Tab_Infos(4) & "/" & Tab_Infos(3) & "/-//"
 
End Function
Sub Format2_Convert()
 
Dim PathSource As String, PathDest As String
Dim FileNumS As Integer, FileNumD As Integer
Dim TmpStr As String
Dim Range As Integer
 
'Recupere le chemin du fichier au format 1 (NMEA)
PathSource = Application.GetOpenFilename(FileFilter:="(*.txt),*.txt", Title:="Sélectionnez le fichier Format2 à convertir")
If PathSource = "Faux" Then Exit Sub 'si pas de sélection faite on quite
 
'On demande a l'utilisateu ou il souhaite enregistrer ce nouveau fichier
PathDest = Application.GetSaveAsFilename(PathSource, FileFilter:="(*.txt),*.txt", Title:="Créer le fichier de destination")
If PathDest = "Faux" Then Exit Sub 'l'utilisateur a annulé l'opération
 
'On verifie que la source est la destination ne sont pas identique
If PathSource = PathDest Then Exit Sub
 
'On stop le rafraichissement
Application.ScreenUpdating = False
 
'Ouvrir le fichier Source
FileNumS = FreeFile
Open PathSource For Input As #FileNumS
 
'Ouvrir/Créer fichier Destination
FileNumD = FreeFile
Open PathDest For Output As #FileNumD
 
'Init
Rang = 0
 
'lire le fichier Source
Do Until EOF(FileNumS)
    Rang = Rang + 1
    Line Input #FileNumS, TmpStr
    TmpStr = ConvertToNMEA(TmpStr, Rang)
    'Inscrire dans le fichier Destination
    Write #FileNumD, TmpStr + vbCrLf
Loop
 
'On ferme les 2 fichiers
Close #FileNumS
Close #FileNumD
 
End Sub
 
Function ConvertToNMEA(Format2Chaine As String, IRang As Integer)
Dim Num As String
Dim PhiG As String
Dim aDate As Date
Dim Vit As String
Dim ROut As String
 
'Rang permet de créer Num
Num = Format(Rang, "00#")
 
'Acquisition des info
 
'Mise en forme des info
 
'Création chaine NMEA
 
 
End Function
 
Sub Creation_barre()
'déclaration des variables
Dim Cbar As CommandBar, TheCell As Range
 
On Error Resume Next
'On supprime un eventuel reste d'un fichier passé
CommandBars("Conversion_GPS").Delete
On Error GoTo 0
 
'création de la barre de menu
Set Cbar = CommandBars.Add(Name:="Conversion_GPS", Position:=msoBarTop, temporary:=True)
Cbar.Protection = msoBarNoCustomize
 
'Bouton convert NMEA
With Cbar.Controls.Add(msoControlButton)
    .TooltipText = "Convertir un fichier NMEA"
    .FaceId = 2648
    .OnAction = "NMEA_Convert"
End With
 
'Bouton convert format2
With Cbar.Controls.Add(msoControlButton)
    .TooltipText = "Convertir un fichier Format2"
    .FaceId = 2649
    .OnAction = "Conversion_GPS"
    .BeginGroup = True
End With
 
'On affiche le menu
Cbar.Visible = True
End Sub
 
Sub Supp_barre()
On Error Resume Next
CommandBars("Conversion_GPS").Delete
 
End Sub

Et le contenu du fichier Source que tu utiliseras avec la macro, mais encore une fois je ne pense pas que ça te soit d'une quelconque utilité.

n° Position UTC SOG COG SOW Cap vrai
935 XX°48'357 N - YYY°53'514 E 25/02/2010 17:51:40 14.9 kn 114.4° 14.4 kn 122.6°
936 XX°48'329 N - YYY°53'580 E 25/02/2010 17:51:53 14.3 kn 125.4° 13.7 kn 132.7°
937 XX°48'293 N - YYY°53'635 E 25/02/2010 17:52:07 13.8 kn 135.7° 13.0 kn 142.9°
938 XX°48'248 N - YYY°53'680 E 25/02/2010 17:52:22 13.3 kn 146.2° 12.5 kn 153.4°