Simplification de macro en passant par une boucle.

[chpierro62]

Bonjour à toutes & à tous,

Alors voilà, j'ai créé une macro VBA sous Project mais cette macro est très répétitive, alors j'ai pensé pouvoir faire une boucle mais je ne vois pas vraiment comment m'y prendre, pouvez-vous me filer un petit coup de pouce s'il vous plait ?

Voici mon code :

Code :

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
Sub Macro1()
' Macro Macro1
' Macro enregistrée le Ven 06/01/12 par ptrien.
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="guide ressort", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    SelectResourceField Row:=54, Column:="Texte12"
    EditPaste
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="1/2 PCM", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    Find Field:="Nom", Test:="Contient", Value:="1/2 PCM", Next:=True, MatchCase:=False
    SelectResourceField Row:=0, Column:="Texte12"
    EditPaste
    ViewApply Name:="Diagramme de Gantt"
    ViewApply Name:="Utilisation des ressources"
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="Pôle de levée", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    Find Field:="Nom", Test:="Contient", Value:="Pôle de levée", Next:=True, MatchCase:=False
    SelectResourceField Row:=0, Column:="Texte12"
    EditPaste
    SelectResourceField Row:=1, Column:="Texte12"
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="PCT", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    SelectResourceField Row:=66, Column:="Texte12"
    EditPaste
    SelectResourceField Row:=1, Column:="Texte12"
    ViewApply Name:="Diagramme de Gantt"
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    SelectResourceField Row:=67, Column:="Texte12"
    EditPaste
    SelectResourceField Row:=2, Column:="Texte12"
    SelectResourceField Row:=-1, Column:="Texte12"
    ViewApply Name:="Diagramme de Gantt"
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    SelectResourceField Row:=68, Column:="Texte12"
    EditPaste
    SelectResourceField Row:=1, Column:="Texte12"
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="Butée", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    Find Field:="Nom", Test:="Contient", Value:="Butée", Next:=True, MatchCase:=False
    SelectResourceField Row:=0, Column:="Texte12"
    EditPaste
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="PCM", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    Find Field:="Nom", Test:="Contient", Value:="PCM", Next:=True, MatchCase:=False
    FindNext
    SelectResourceField Row:=0, Column:="Texte12", Width:=1
    EditPaste
    SelectResourceField Row:=1, Column:="Texte12"
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="TSCM", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    Find Field:="Nom", Test:="Contient", Value:="TSCM", Next:=True, MatchCase:=False
    SelectResourceField Row:=0, Column:="Texte12", Width:=1
    EditCopy
    EditCopy
    EditPaste
    ViewApply Name:="Diagramme de Gantt"
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    SelectResourceField Row:=71, Column:="Texte12"
    EditPaste
    SelectResourceField Row:=1, Column:="Texte12"
    ViewApply Name:="Diagramme de Gantt"
    Find Field:="Nom", Test:="Contient", Value:="tube guide", Next:=True, MatchCase:=False
    SelectTaskField Row:=0, Column:="Remarques", Width:=1
    EditCopy
    ViewApply Name:="Utilisation des ressources"
    Find Field:="Nom", Test:="Contient", Value:="tube guide", Next:=True, MatchCase:=False
    SelectResourceField Row:=20, Column:="Texte12"
    EditPaste
    SelectResourceField Row:=1, Column:="Texte12"
    ViewApply Name:="Diagramme de Gantt"
End Sub

Merci à tous pour votre aide précieuse !