Progressbar avec copie des dossiers

[Lone-wolf]

Bonjour à tous.

Je n'arrive pas à faire progresser la barre pendant la copie des fichiers.

Pourriez-vous m'aider s'il vous plaît?

Pour l'instant j'ai ceci:

Sub Install()

Set fso = CreateObject("Scripting.FileSystemObject")
source = ThisWorkbook.Path & "\WinBlue"
destination = chemin & "\"
fso.CopyFolder source, destination, False
Application.Cursor = xlNorthwestArrow
End Sub

Fichier: WinBlue

 

[Lone-wolf]

Re : Progressbar avec copie des dossiers

Voilà, j'ai introduit un autre petit gadget dans le code.

"Déscente automatique de la barre de défilement de la ListBox."

' Inscription dans la Listbox
For Each f2 In f1.Files
' colonne[B]noms fichiers
Cells(x - 1, 2).Value = f2.Name
WinBlue.TbFiles.Value = "Fichier: " & Cells(x - 1, 2).Value
x = x + 1
On Error Resume Next
WinBlue.Ecran.Selected(x - 1) = True

t = Timer + 0.2: Do Until Timer > t: DoEvents: Loop
WinBlue.Progressbar.Visible = True
' on divises le nombre de fichiers par la largeur de la barre
' ici: 1000 / 262 = 3.816... .
' on redivises 1000 par 3.816 et on augmente (ici 3.84) pour ajuster la barre.
WinBlue.Progressbar.Width = x / 3.84
Next f2

Les lignes ajoutées sont celles-ci:

On Error Resume Next
WinBlue.Ecran.Selected(x - 1) = True

Question: peut-on modifier sa couleur en blanc?



A+

 

[Lone-wolf]

Re : Progressbar avec copie des dossiers

Personne peut m'aider sur ce problème??? 🙁

 

[Compte Supprimé 979]

Re : Progressbar avec copie des dossiers

Salut Lone-wolf,

Il faut dire que perso, je ne sais pas d'ou tu sors

WinBlue.Ecran.Selected(x - 1) = True

Et comme ça je dirais, vu que c'est "WinBlue" ça ne peut pas être en blanc 🙂

A+

 

[Lone-wolf]

Re : Progressbar avec copie des dossiers

Bonsoir Bruno,

cette commande sert à faire déscendre automatiquement la barre de la ListBox.
WinBlue est le nom du formulaire.

A+

 

[Compte Supprimé 979]

Re : Progressbar avec copie des dossiers

Re,

Pour moi, vu que tu lances la copie entière d'un répertoire,
tu ne peux pas intégrer ton progressbar !

Mais peut-être que je me trompe 😉

A+

 

[Lone-wolf]

Re : Progressbar avec copie des dossiers

Tu veus dire que je devrais tout mettre dans un dossier?

 

[Compte Supprimé 979]

Re : Progressbar avec copie des dossiers

Re,

Non, je veux dire qu'il faudrait effectuer la copie pour chaque fichier

Essaye ça 😉

Sub Install()
  Dim FSO As Scripting.FileSystemObject
  Dim DosSce As Scripting.Folder
  Dim F1 As Scripting.File
  Dim Source As String, Destination As String
  Dim X As Integer
  
  ' Instancier le File System Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ' Définir le chemin source
  Source = ThisWorkbook.Path & "\WinBlueSAV"
  ' Instancier le dossier source
  Set DosSce = FSO.GetFolder(ThisWorkbook.Path & "\WinBlue")
  ' Définir la destination
  Destination = Chemin & "\"
  ' Pour chaque fichier du dossier source
  For Each F1 In DosSce.Files
    X = X + 1
    FSO.CopyFile F1, Destination
    WinBlue.Progressbar.Width = X / 3.84
  Next F1
  Application.Cursor = xlNorthwestArrow
End Sub

A+

 

[Lone-wolf]

Re : Progressbar avec copie des dossiers

Bonjour Bruno,

je viens de faire l'éssai. Je passe de "Installation WinBlue" à "Fin d'installation"
sans copie des dossiers.

J'ai remarqué que la barre, à chaque changement de dossier, disparaît un court instant (1 fraction de seconde); c'est du à quoi?

Avec les anciens modèles je n'ai jamais u de problèmes.

 

[Paritec]

Re : Progressbar avec copie des dossiers

Bonjour Lone Bruno 🙂,
oui quand je lis "Voilà, j'ai introduit un autre petit gadget dans le code."
je pense que ton code entier est un gadget?
en plus tu ne prends même pas le temps de lire ce que l'on prend le temps de t'écrire,
compte tenu du fait que tu ne sais pas ce que tu va récupérer, comment veux tu incrémenter de manière sérieuse un progressbar?
si en début de code tu savais combien tu as de fichiers dans le répertoire OK mais ce ne sera jamais le cas, alors comment veux-tu avoir une démarche logique?
Ou alors tu le sais déjà, et là tu as une liste de tes fichiers et donc la macro ne sert plus à rien? Bref sans comprendre la finalité du fichier pas simple, mais Bruno a l'air lui de comprendre ce que tu veux, je vais suivre attentivement.
bonne journée
a+
Papou 🙂

 

[Lone-wolf]

Re : Progressbar avec copie des dossiers

Bonjour Paritec,

d'accord je ne suis pas un crack en VBA, mais tout de même...

Si tu regarde bien, j'ai mis le fichier joint. Dans celui-ci, en commentaire,
je sais combien de sous-dossiers et fichiers j'ai à mon actif; (4 sous-dossiers) et 600 fichiers
(j'en ai supprimé quelques-un entre deux), sans sous-sous-dossiers.

Ces fichiers comprennes des: .dll, .ocx, .ico, .dll.log, .exe, .cpl, .wav, .exe.log, .ocx.log.

A+