Bonjour à tous,
J'ai réalisé une macro automatique pour mon entreprise qui récupère les données des planning de tous le monde et les range dans un fichier "synthèse".
Lors de ma programmation en local tout fonctionne très bien. une fois en place sur le réseau la macro s’exécute correctement mais ensuite le fichier de synthèse gèle pendant quelques secondes a interval régulier.
Je ne connais pas bien le VBA mais je pense que ma macro continue de travailler après sont exécution et je n'arrive pas à l’arrêter.
Une fois les données triées dans mon fichier de synthèse je n'ai pas besoin de mise a jour car j'envisageai un bouton pour relancer la macro au besoin.
Ci joint le code principale qui appel les plannings:
Puis le code d'un planning pour exemple:
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 Sub LancerMacroClasseur2() Dim Ligne As Long Dim Jour As Long Dim Delai As Long Ligne = 2 Jour = Day(Date) Delai = 2 Range("A2:P1100").Select Selection.ClearContents Application.ScreenUpdating = False ' Plannings On Error Resume Next Call ACACIO(Jour, Ligne, Delai) On Error Resume Next Call BIBI(Jour, Ligne, Delai) On Error Resume Next Call DAVID(Jour, Ligne, Delai) On Error Resume Next Call DOMINIQUE(Jour, Ligne, Delai) On Error Resume Next Call JOSEPH(Jour, Ligne, Delai) On Error Resume Next Call JULIE(Jour, Ligne, Delai) On Error Resume Next Call MARIECLAIRE(Jour, Ligne, Delai) On Error Resume Next Call PHILLIPE(Jour, Ligne, Delai) On Error Resume Next Call SEBASTIEN(Jour, Ligne, Delai) On Error Resume Next Call VICTOR(Jour, Ligne, Delai) On Error Resume Next Call ZORAN(Jour, Ligne, Delai) ' Fin Plannings Columns("B:B").Select Range("A2:G837").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("H2").Select ActiveWorkbook.Saved = True Application.ScreenUpdating = True End Sub
Merci par avance pour votre aide.
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 Sub DAVID(Jour, Ligne, Delai) Workbooks.Open Filename:="Q:\planning production\DAVID-" & Jour & ".xls", UpdateLinks:=False Sheets("DAVID").Select Range("A8:G26").Copy ThisWorkbook.Sheets("SYNTHESE").Cells(Ligne, 1).PasteSpecial _ xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=True, Transpose:=False Ligne = Ligne + 19 Range("A28:G33").Copy ThisWorkbook.Sheets("SYNTHESE").Cells(Ligne, 1).PasteSpecial _ xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=True, Transpose:=False Ligne = Ligne + 6 Range("J7:P23").Copy ThisWorkbook.Sheets("SYNTHESE").Cells(Ligne, 1).PasteSpecial _ xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=True, Transpose:=False Ligne = Ligne + 17 Range("J26:P42").Copy ThisWorkbook.Sheets("SYNTHESE").Cells(Ligne, 1).PasteSpecial _ xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=True, Transpose:=False Ligne = Ligne + 17 Range("J45:P61").Copy ThisWorkbook.Sheets("SYNTHESE").Cells(Ligne, 1).PasteSpecial _ xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=True, Transpose:=False Ligne = Ligne + 17 ThisWorkbook.Sheets("SYNTHESE").Cells(Delai, 9).Value = "DAVID" If Range("A1").Value = "1" Then ThisWorkbook.Sheets("SYNTHESE").Cells(Delai, 10).Value = "4-8 JOURS" ElseIf Range("A1").Value = "2" Then ThisWorkbook.Sheets("SYNTHESE").Cells(Delai, 10).Value = "8-10 JOURS" Else ThisWorkbook.Sheets("SYNTHESE").Cells(Delai, 10).Value = "10-12 JOURS" End If Range("C52").Copy ThisWorkbook.Sheets("SYNTHESE").Cells(Delai, 11).PasteSpecial _ xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=True, Transpose:=False Delai = Delai + 1 Application.DisplayAlerts = False ActiveWorkbook.Close False End Sub
Partager