Discussion :

[canichon]

bonjour a tous,

j'ai une macro qui permet de faire des tranferts de fichier suivant une liste...

en gros, la macro parcours la liste, va chercher le fichier dans un repertoire, le renomme et le colle dans un autre repertoire.

a chaque fois qu'un tranfert est fait, je colore la cellule en vert : tranfert OK

a la fin, j'ai une liste de "manquant" et quand je checke, les manquants ne le sont pas forcément

lors de l'execution de la macro, l'écran se bloque ( la macro ne répond plus ) et reviens correctement a la fin.

je voulais savoir si, comme la macro s'execute TRES vite, le transfert de fichier ne se ferait pas systématiquement ??? la macro allant plus vite que le transfert de fichier !!!

voilà, si quelq'un a une idée...

merci d'avance
voilà

[EngueEngue]

Montre nous ta macro.

[canichon]

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
Sub Ranger_plans_detail()
 
Dim objFSO, objDossier, objFichier, objResultat
Dim Repertoire_plans, Repertoire_ranger
Dim objShell As Object, objfolder As Object
Dim val As String
Dim gestionfichier As New Scripting.FileSystemObject
 
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
 
MsgBox ("Les plans doivent être exportés et l'arborescence créée")
 
'--------------------------------------'
' Chemin réseau du répertoire de plans '
'--------------------------------------'
 
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.BrowseForFolder(0, "Les plans sont dans :", 0)
 
Repertoire_plans = objfolder.parentfolder.ParseName(objfolder.Title).Path
 
'---------------------------------'
' Chemin réseau de l'arborescence '
'---------------------------------'
 
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.BrowseForFolder(0, "La racine de l'arborescence est :", 0)
 
Repertoire_ranger = objfolder.parentfolder.ParseName(objfolder.Title).Path
 
'-----------------------------'
' OUVERTURE DU FICHIER DE BOM '
'-----------------------------'
 
MsgBox ("Ouvrez le fichier contenant la liste des plans ( fichier BOM - ***.xls )")
Application.FindFile
 
nomfichierBOM = ActiveWorkbook.Name
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDossier = objFSO.GetFolder(Repertoire_plans)
 
boucle = objDossier.Files.Count - 1
compteur = 0
 
Application.ScreenUpdating = False
 
    Workbooks(nomfichierBOM).Activate
    Sheets("Liste de tous les plans").Select
    Range("B6").Select
    Do Until ActiveCell = ""
        myfile = "toto"
        If ActiveCell.Offset(0, 2) = "Assembly" Then
            ActiveCell.Offset(1, 0).Select
            Else
                If ActiveCell.Offset(0, 2) = "Detail" Then
                    donnee_maitre = ActiveCell
                    rev = ActiveCell.Offset(0, 1)
                    Item = ActiveCell.Offset(0, -1)
                    desig = ActiveCell.Offset(0, 3)
                    Sheets("Liste d'Items").Select
                    Columns("A:A").Find(What:=Item).Select
                    desig_item = ActiveCell.Offset(0, 1)
                    Sheets("Liste de tous les plans").Select
 
                    Do Until myfile = ""
                        If myfile = "toto" Then
                            recherche = Repertoire_plans & "\" & donnee_maitre & "_" & rev & "*.*"
                            myfile = Dir(recherche)
                        End If
                        If myfile = "" Then
                            ActiveCell.Interior.ColorIndex = 3
                        Else
                            ActiveCell.Interior.ColorIndex = 4
                            foliotemp = Right(myfile, (Len(myfile) - 12))
                            folio = Left(foliotemp, (Len(foliotemp) - 4))
                            extension = Right(foliotemp, 4)
 
                            repertoire_source = Repertoire_plans & "\" & myfile
 
                            repertoire_destination = Repertoire_ranger & "\" & Item & " - " & desig_item & "\" & Item & " Detail - " & donnee_maitre & " " & rev & " - " & desig & " ( " & folio & " )" & extension
 
                            gestionfichier.copyfile repertoire_source, repertoire_destination
                            myfile = Dir()
                        End If
                    Loop
                    ActiveCell.Offset(1, 0).Select
                    Application.StatusBar = "Item : " & Item
                End If
            End If
    Loop
 
  Set objDossier = Nothing
  Set objFSO = Nothing
 
Application.ScreenUpdating = True
 
End Sub

je sais pas si ça aidera beaucoup...

[EngueEngue]

Code :

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

If myfile = "toto" Then

comprends pas ce qu'il vient faire

essaie de mettre cette ligne :

Code :

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

ActiveCell.Interior.ColorIndex = 4

Après celle là

Code :

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

gestionfichier.copyfile repertoire_source, repertoire_destination

[canichon]

il est clair que ma macro n'est pas optimisée ce qui ralenti l'execution mais de la a "sauter" des boucles...

après il y a le format de base des fichiers que je déplace... je vais regarder aussi de ce coté là...