Discussion :

[Jean-Luc80]

Bonjour
J'aimerais soumettre à votre sagacité ce code que j'ai fait pour un formulaire de sauvegarde de fichiers annexes à ma base ( photos )

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
If Forms![Sauvegarde]![CocheAffiches] = True Then
        Set FSO = New Scripting.FileSystemObject
        Set oDb = DBEngine.OpenDatabase("C:\access\DVDData.mdb")
        Set oRst = oDb.OpenRecordset("Vidéo", dbOpenTable)
        Set oRst = oDb.OpenRecordset("SELECT RéfCollectionVidéo,Image FROM Vidéo ", dbOpenDynaset)
        Set ProgressBar = Me.ProgressBar.Object
        oRst.MoveLast
        nbMax = oRst.RecordCount
        oRst.MoveFirst
        While Not oRst.EOF
            destination = "D:\affiches\"
            source = "C:\affiches\" & oRst.Fields("Image").value
            FSO.CopyFile source, destination, True
            With ProgressBar
    .BorderStyle = FixedSingle
    .FontColour = 0
    .BackColour = -2147483633
    .value = 0
    .DotWidth = 1
    .GapWidth = 0
    .MarginSize = 0
    .ReverseGradient = False
    .Min = 0
    .Max = nbMax
    .GradientColour = GradientBlue
End With
            Fichiers.Visible = True
            While ProgressBar.value < nbMax
                ProgressBar.value = ProgressBar.value + 1
                Fichiers.value = "Copie de " & source & " vers " & destination & oRst.Fields("Image").value
                DoEvents
            Wend
            oRst.MoveNext
       Wend
        oRst.Close
        oDb.Close
        Set oRst = Nothing
        Set oDb = Nothing
Set FSO = Nothing
Fichiers.Visible = False
ProgressBar.value = 0
   End If

La progressBar utilisée n'est pas celle de chez Microsoft mais une autre avec plus de possibilités de paramètres
Mon Pb est le suivant
J'ai une barre de progression à chaque copie de fichier! alors que j'en voudrais qu'une seule pour toute la durée des copies
S'il y a 600 fichiers à copier j'ai 600 fois la barre et c'est très long !
Je pense que le Pb vient de l'imbrication des deux

Code :

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

While...wend

??
Merci de vos conseils
A +

[LedZeppII]

Bonsoir,

Il faut enlever la partie While ... Wend et faire l'initialisation de la barre de progression en dehors de la boucle sur le recordset.

J'ai effectué quelques couper/coller dans ton code pour aller dans ce sens.

Code vb :

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
If Forms![Sauvegarde]![CocheAffiches] = True Then
        Set FSO = New Scripting.FileSystemObject
        Set oDb = DBEngine.OpenDatabase("C:\access\DVDData.mdb")
        Set oRst = oDb.OpenRecordset("Vidéo", dbOpenTable)
        Set oRst = oDb.OpenRecordset("SELECT RéfCollectionVidéo,Image FROM Vidéo ", dbOpenDynaset)
        Set ProgressBar = Me.ProgressBar.Object
        oRst.MoveLast
        nbMax = oRst.RecordCount
        oRst.MoveFirst
 
        ' Initialisaiton de la barre de progression
        With ProgressBar
		    .BorderStyle = FixedSingle
		    .FontColour = 0
		    .BackColour = -2147483633
		    .value = 0
		    .DotWidth = 1
		    .GapWidth = 0
		    .MarginSize = 0
		    .ReverseGradient = False
		    .Min = 0
		    .Max = nbMax
		    .GradientColour = GradientBlue
		End With
 
        While Not oRst.EOF
            destination = "D:\affiches\"
            source = "C:\affiches\" & oRst.Fields("Image").value
            FSO.CopyFile source, destination, True
            Fichiers.Visible = True
 
            ProgressBar.value = ProgressBar.value + 1
            ' ou équivalent :
            ' ProgressBar.Value = oRst.AbsolutePosition + 1
 
            Fichiers.value = "Copie de " & source & " vers " & destination & oRst.Fields("Image").value
            DoEvents
 
            oRst.MoveNext
        Wend
        oRst.Close
        oDb.Close
        Set oRst = Nothing
        Set oDb = Nothing
Set FSO = Nothing
Fichiers.Visible = False
ProgressBar.value = 0
End If

A+

[Jean-Luc80]

Je te remercie beaucoup de tes conseils
Ca marche impec,c'est exactement ce que je voulais obtenir.
Maintenant je sais intégrer des ActiveX dans un formulaire et j'ai plein d'idées pour améliorer le look de ma base.
Bonne journée
A +