Lut,
Je ne comprends pas ton problème. Soit plus clair
Théo
Lut,
Je ne comprends pas ton problème. Soit plus clair
Théo
Forums VB : lire la notice
La touche existe pour être utilisée
Pensez au tag
Pour ceux n'ayant pas l'aide installée :
- Aide MSDN pour VB6
- Aide MSDN pour VBA
Je ne réponds pas aux questions techniques par MP. Merci d'utiliser le forum fait pour çà.
Je voudrais que qd j'ajoute un fichier de la List 1 (a gauche) à la List2 (à droite) ca créé l'objet dans la base de données et que ca s'affiche dans le menu "liste des fichiers" (j sais pas si t as vu dans la PJ que j ai mis). D'habitude pr créer un nouvel objet, je passais par une form (SaisieNouveau) dans laquelle je chargais le controle voulu (en l'occurence Ctrl_Fichiers).
Voila j sais pas si j ai ete assez clair...
Pour la base de données, désolé mais j'y connais rien donc je peux pas t'aider à ce niveau...Envoyé par Ribéry
Pour l'écriture dans le menu liste des fichiers, qu'est-ce que tu as déjà codé ? As quel niveau tu bloques ?
+
Théo
Forums VB : lire la notice
La touche existe pour être utilisée
Pensez au tag
Pour ceux n'ayant pas l'aide installée :
- Aide MSDN pour VB6
- Aide MSDN pour VBA
Je ne réponds pas aux questions techniques par MP. Merci d'utiliser le forum fait pour çà.
J'te mets mon code tel quel. Je bloque...tout simplement...je sais meme pas a quel niveau...Pour ecrire ca j me suis inspiré d'un code que j'utilise pour créer un module à partir d'un objet. Cad qu'en fait qd je crée un fichier ca crée automatiquement un module ou on pourra gérer les droits sur ce fichier. La, j'ai voulu faire le meme procédé pr créer le fichier et voila ou j'en suis....
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
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456 Option Explicit '*********************************************************************************** '*Contrôle : MiseJourFichiers * '*Projet : Configurateur * '*Date : 04/07/2006 * '*Auteur : * '*********************************************************************************** '* * '* * '* * '*********************************************************************************** 'Définition des variables locales associées aux propriétés '********************************************************* Event Change() Event Supprime(CommandeSQL As String, Numéro As Long) Event Précédent(Numéro As Long) Event Suivant(Numéro As Long) Event ModifFichiers(TypeModule As ListeTypeObjet, Action As ActionListeFichiers) 'Définition des variables locales associées aux propriétés '********************************************************* Private WithEvents mvar_ObjetLié As clsFichiers Private mvar_ListeLiée As ListView Private mvarNom_Fichiers As String Private mvarNuméro As Byte Private mvarNouveauNuméro As Byte Private mvarAppareil_Fichiers As New clsAppareil Private mvarAncien_Appareil As New clsAppareil Private mModification As Boolean Private m_Objet As Object Private m_Création As Boolean Private m_TypeListe As ListeTypeObjet Private m_NuméroInfo As Long Dim StrScanFolderFtp As String Dim CancelAction As Boolean Public Function AddSlash(ByVal SlashStr As String) As String '-- Ajouter un "\" dans un path If Len(SlashStr) = 0 Then Exit Function If Right$(SlashStr, 1) <> "\" Then SlashStr = SlashStr & "\" AddSlash = SlashStr End Function Sub WaitExecute(InetCtl As Inet) '-- Attendre la fin d'execution d'une instruction d'un controle Inet While InetCtl.StillExecuting DoEvents Wend End Sub Public Function ScanFolderFtp(Optional FolderPath As String = "", Optional Filename As String = "", Optional SubFold As Boolean = True) As Long '-- Fonction récursive pour l'exploration des répertoires Ftp Dim StrPath() As String Dim subFolders As New Collection Dim i As Integer With Inet1 On Error GoTo TraiteErreur .Execute , "DIR " WaitExecute Inet1 StrPath = Split(Replace(StrScanFolderFtp, "/", "\"), vbCrLf) For i = 0 To UBound(StrPath) - 1 '-- Affichage dans la listbox If InStr(1, StrPath(i), ".\") = 0 And Len(StrPath(i)) > 0 Then MiseJourFichiers.List1.AddItem AddSlash(FolderPath) & StrPath(i) End If '-- Remplir la collection des sous-dossiers du dossier en cours If Right(StrPath(i), 1) = "\" And InStr(1, StrPath(i), ".\") = 0 Then subFolders.Add Left(StrPath(i), Len(StrPath(i)) - 1) End If Next MiseJourFichiers.List1.AddItem ("/") '-- Renvoie le nombre d'éléments du dossier en cours ScanFolderFtp = UBound(StrPath) '--Recherche dans les sous-dossiers If SubFold Then For i = 1 To subFolders.Count Debug.Print subFolders.Item(i) .Execute , "CD " & subFolders.Item(i) WaitExecute Inet1 DoEvents If CancelAction Then Exit Function ScanFolderFtp = ScanFolderFtp + ScanFolderFtp(AddSlash(FolderPath) & subFolders.Item(i), , SubFold) .Execute , "CDUP" WaitExecute Inet1 Next i End If '-- Vide la collection des sous-dossiers Set subFolders = Nothing End With TraiteErreur: AfficheErreur End Function Private Sub Ajouter_Click(Index As Integer) Dim FichPres As Boolean Dim mvarModification As Boolean Dim i As Integer With mvar_ObjetLié FichPres = False If List1.ListIndex >= 0 Then For i = 0 To List2.ListCount - 1 If List1.List(List1.ListIndex) = List2.List(i) Then FichPres = True 'Fichier présent dans la List2 End If Next i If Not FichPres Then List2.AddItem List1.List(List1.ListIndex) List1.RemoveItem (List1.ListIndex) SauveModifications CréationModule mFichiers, mvarModification End If End If End With End Sub Private Sub Annuler_Click(Index As Integer) Unload Me End Sub Private Sub Supprime_Click() If List2.ListIndex >= 0 Then List2.RemoveItem (List2.ListIndex) End If End Sub Private Sub Command2_Click() mMessage.Refresh With Inet1 List1.Clear .AccessType = icDirect .Protocol = icFTP .URL = txtURL.Text .UserName = txtName.Text .Password = txtPassword.Text ScanFolderFtp '.Execute , "CLOSE" WaitExecute Inet1 End With End Sub Private Sub Form_Load() txtURL.Text = "ftp:// txtName.Text = "" txtPassword.Text = "" LoadResStrings Me AfficheInfoFichiers End Sub Private Sub Inet1_StateChanged(ByVal State As Integer) ' Récupère la réponse du serveur à l'aide de ' la méthode GetChunk lorsque State = 12. Dim vtData As Variant ' Variable Data. Select Case State Case icError ' 11 ' En cas d'erreur, renvoie ResponseCode et ' ResponseInfo. vtData = Inet1.ResponseCode & ":" & _ Inet1.ResponseInfo Case icResponseCompleted Dim strData As String Dim bDone As Boolean: bDone = False ' Lecture du premier segment vtData = Inet1.GetChunk(1024, icString) DoEvents ' Lecture des segments suivants Do While Not bDone strData = strData & vtData vtData = Inet1.GetChunk(1024, icString) DoEvents If Len(vtData) = 0 Then bDone = True End If Loop StrScanFolderFtp = strData End Select End Sub Private Sub AfficheInfoFichiers() Dim ItemX As ListItem Dim Cpte As Integer Dim ListeFichiersCréés As New clsListeObjet DoEvents 'Constitution de la liste des fichiers déclarés '********************************************** ListeFichiersCréés.Populate mFichiers With ListeFichiersCréés With ListeFichiersCréés If .Count <> 0 Then 'Il y a des modules déclarés '*************************** For Cpte = 1 To .Count List2.AddItem .Item(Cpte).Nom Next Cpte End If End With End With End Sub Private Sub AfficheErreur() mMessage.Refresh mMessage.ForeColor = vbRed mMessage.Caption = "Tranfert FTP impossible !!" End Sub Private Sub AfficheErreurPassword() mMessage.Refresh mMessage.ForeColor = vbRed mMessage.Caption = LoadRessourceString(IDErreurPassword) End Sub Private Sub AfficheErreurUserName() mMessage.Refresh mMessage.ForeColor = vbRed mMessage.Caption = LoadRessourceString(IDErreurUser) End Sub Private Sub AfficheErreurURL() mMessage.Refresh mMessage.ForeColor = vbRed mMessage.Caption = LoadRessourceString(IDErreurURL) End Sub Public Property Get ObjetLié() As clsFichiers 'Donne l'objet clsGestionFichiers lié au contrôle '********************************************** Set ObjetLié = mvar_ObjetLié End Property Public Property Set ObjetLié(ByVal New_ObjetLié As clsFichiers) If Ambient.UserMode = False Then Err.Raise 383 'Un objet clsGestionFichiers est lié au contrôle '********************************************* If Not (New_ObjetLié Is Nothing) Then If Not (mvar_ObjetLié Is New_ObjetLié) Then 'L'objet lié va changé, on sauvegarde l'ancien '********************************************* SauveModifications End If End If Set mvar_ObjetLié = New_ObjetLié GestionObjetLié End Property Public Sub SauveModifications() Dim Cpte As Integer Dim NouveauMOD As clsFichiers If Not (mvar_ObjetLié Is Nothing) Then With mvar_ObjetLié 'Un objet est lié, mise à jour de ces propriétés '*********************************************** .Nom = List1.List(List1.ListIndex) .NouveauNuméro = List2.ListCount + 1 If .Sauve(BDDModification) Then 'Des modifications ont été constatées, l'objet a été sauvé, 'mise à jour de la liste liée '********************************************************** MiseJourListeLiée .Nom, .Numéro End If End With End If End Sub Private Sub GestionObjetLié() Dim mModule As clsModulesGestionDroits If Not (mvar_ObjetLié Is Nothing) Then With mvar_ObjetLié 'Mise à jour de l'interface utilisateur 'avec les informations de l'objet '************************************** List1.Text = .Nom List2.ListCount 1 = .Numéro End With End If End Sub Private Sub mvar_ObjetLié_ModifFichiers(TypeModule As ListeTypeObjet, Action As ActionListeFichiers) RaiseEvent ModifFichiers(TypeModule, Action) End Sub Private Sub UserControl_Terminate() 'Sauvegarde des éventuelle modifications '*************************************** SauveModifications End Sub Private Sub MiseJourListeLiée(Nom As String, _ Index As String) Dim ItemX As ListItem If Not (mvar_ListeLiée Is Nothing) Then 'Mise à jour de la liste liée '**************************** On Error Resume Next If (mvar_ListeLiée.ListItems.Count) Then 'Sélection de l'Item concerné '**************************** Set ItemX = mvar_ListeLiée.ListItems("FICH" & mvar_ObjetLié.Numéro) 'Mise à jour '*********** ItemX.Text = Nom End If End If End Sub Private Sub CréationModule(mvarType_Fichiers As ListeTypeObjet, _ mvarModification As Boolean) Dim mvarModule As New clsModulesGestionDroits 'Création d'un nouveau module de gestion des droits '************************************************** With mvarModule .Nom = mvarNom_Fichiers .Type_Fichiers = mvarType_Fichiers .Index_Fichiers = mvarNouveauNuméro .Sauve mvarModification End With Set mvarModule = Nothing RaiseEvent ModifFichiers(mvarType_Fichiers, mAjout) End Sub Public Function InitProperties(ByVal ADO_Recordset As ADODB.Recordset, _ vData As Long) As Long Dim mOuvert As Boolean If ADO_Recordset Is Nothing Then 'Aucun objet recordset passé en paramètre, il faut en créer un '************************************************************* mOuvert = True BDDProjet.CommandeText = SQL_Fichiers_par_Index Set ADO_Recordset = BDDProjet.ExecuteCommande(vData) End If With ADO_Recordset 'Recherche du module demandé '*************************** .Find ChampIndex_Fichiers & " = " & vData If Not .EOF Then 'Il existe, initialisation des propriétés 'avec les valeurs contenues dans la BDD '**************************************** InitProperties = vData On Error Resume Next mvarNom_Fichiers = .Fields(ChampNom_Fichiers) mvarNuméro = .Fields(ChampIndex_Fichiers) mvarAppareil_Fichiers.TypeAppareil = .Fields(ChampAppareil_Fichiers) mvarAncien_Appareil.TypeAppareil = .Fields(ChampAppareil_Fichiers) Else 'Il n'existe pas, initialisation des propriétés 'avec des valeurs par défaut '********************************************** InitProperties = 255 mvarAppareil_Fichiers.TypeAppareil = -1 mvarAncien_Appareil.TypeAppareil = -1 End If End With If mOuvert Then 'Le recordset a été ouvert par la fonction, on le ferme 'et on détruit l'objet '****************************************************** ADO_Recordset.Close End If End Function Public Property Let Nom(ByVal vData As String) 'Nom du fichier '************* If mvarNom_Fichiers <> vData Then mvarNom_Fichiers = vData mModification = True End If End Property Public Property Get Nom() As String Nom = mvarNom_Fichiers End Property Public Property Let Numéro(ByVal vData As Byte) 'Index du fichier '**************** mvarNuméro = vData mvarNouveauNuméro = vData InitProperties Nothing, CLng(vData) End Property Public Property Get Numéro() As Byte Numéro = mvarNuméro End Property Public Property Let NouveauNuméro(ByVal vData As Byte) 'Nouvel Index du fichier '********************** If mvarNouveauNuméro <> vData Then mvarNouveauNuméro = vData mModification = True End If End Property Public Property Let Appareil_Type(ByVal vData As Integer) 'Non utlisé '********** If mvarAppareil_Fichiers.TypeAppareil <> vData Then mvarAppareil_Fichiers.TypeAppareil = vData mModification = True End If End Property Public Property Get Appareil_Type() As Integer Appareil_Type = mvarAppareil_Fichiers.TypeAppareil End Property Public Property Get Appareil_Nom() As String 'Non utilisé '*********** Appareil_Nom = mvarAppareil_Fichiers.Libellé End Property
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager