Bonjour,

j'ai un bouton sur ma feuille excel qui lance le code suivant :

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
 
Private Sub CommandButton1_Click()
 
If ThisWorkbook.Sheets("Plan").Range("J1").Value = "" Then
    MsgBox "[ATTENTION] Numéro de dossier VIDE!!", vbOKOnly + vbCritical, "Message de Pascal!"
    Exit Sub
Else
 
Application.ScreenUpdating = False
retry:
pmcopie = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 9, 0)
pmdate = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 11, 0)
pmjustif = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 12, 0)
pment = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 2, 0)
 
If pmcopie = "o" And pmjustif <> "p" Then
    Monfichier = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 10, 0)
    rep = "Z:\Suivi dossiers PM-LS\Dossiers PP\"
    Set wb = Workbooks.Open(Filename:=rep & Monfichier)
    GoTo masuite:
 
ElseIf pmcopie = "o" And pmjustif = "p" Then
    Monfichier = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 10, 0)
    rep = "Z:\Suivi dossiers PM-LS\Mutualisation\"
    Set wb = Workbooks.Open(Filename:=rep & Monfichier)
    GoTo masuite:
 
masuite:
        If wb.ReadOnly Then
        wb.Close False
        If MsgBox("[ATTENTION] Le fichier " & Monfichier & " est ouvert !", vbRetryCancel + vbCritical, "Message de Pascal!") = vbRetry Then
        GoTo retry:
        Else
        GoTo pasretry:
        End If
        Else
 
Dim NewLig As Long
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Sheets("Plan")
pmannee = Sh.Range("F1").Value
 
    Dim x As Range
        Set x = Workbooks(Monfichier).Worksheets(pmannee).Range("A1:A9999").Find(Sh.Range("F1").Value & Sh.Range("H1").Value & Left(WorksheetFunction.Text(Sh.Range("J1").Value, "00000"), 5), , xlValues, xlWhole, , , False)
        If Not x Is Nothing Then
        If MsgBox("[ATTENTION] Le dossier " & Sh.Range("F1").Value & Sh.Range("H1").Value & Left(WorksheetFunction.Text(Sh.Range("J1").Value, "00000"), 5) & " existe déjà !" & vbCrLf & vbCrLf & "Voulez-vous juste imprimer la feuille?", vbOKCancel + vbQuestion, "Message de Pascal!") = vbOK Then
        wb.Close False
        GoTo mafinimpr:
        Else
        wb.Close False
        GoTo mafin:
        End If
        End If
 
With Workbooks(Monfichier).Worksheets(pmannee)
    NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    If NewLig < 20 And pmjustif <> "p" Then NewLig = 20
    If NewLig < 20 And pmjustif = "p" Then NewLig = 4
    If NewLig > 20 Then
    .Rows(NewLig).Copy
    .Rows(NewLig + 1).Resize(1).Insert Shift:=xlDown
    End If
 
    If (Val(Sh.Range("C25").Value) = 0 Or (Sh.Range("C25").Value) = "") Then
    Rows("25:26").Hidden = True
    Rows("27:28").Hidden = False
    End If
    If (Val(Sh.Range("C29").Value) = 0 Or (Sh.Range("C29").Value) = "") Then
    Rows("29:30").Hidden = True
    Rows("31:32").Hidden = False
    End If
    If (Val(Sh.Range("C33").Value) = 0 Or (Sh.Range("C33").Value) = "") Then
    Rows("33:34").Hidden = True
    Rows("35:36").Hidden = False
    End If
    If (Val(Sh.Range("C37").Value) = 0 Or (Sh.Range("C37").Value) = "") Then
    Rows("37:38").Hidden = True
    Rows("39:40").Hidden = False
    End If
 
    If pment = "101" Then
    .Range("A" & NewLig).Value = (Sh.Range("F1").Value & Sh.Range("H1").Value & Left(WorksheetFunction.Text(Sh.Range("J1").Value, "00000"), 5))
    .Range("B" & NewLig).Value = Sh.Range("B12").Value & " " & Sh.Range("B13").Value
    .Range("C" & NewLig).Value = IIf(Val(Sh.Range("B15").Value) <> 0, Sh.Range("B15").Value, "")
    .Range("D" & NewLig).Value = IIf(Val(Sh.Range("B16").Value) <> 0, Sh.Range("B16").Value, "")
    .Range("E" & NewLig).Value = IIf(Val(Sh.Range("C21").Value) <> 0, (Sh.Range("C21").Value + Sh.Range("C29").Value + Sh.Range("C33").Value), "")
    .Range("G" & NewLig).Value = IIf(Val(Sh.Range("E21").Value) <> 0, Sh.Range("E21").Value, "")
    .Range("J" & NewLig).Value = IIf(Val(Sh.Range("I25").Value) <> 0, Sh.Range("I25").Value, "")
    .Range("K" & NewLig).Value = IIf(Val(Sh.Range("I21").Value) <> 0, (Sh.Range("I21").Value + Sh.Range("I37").Value), "")
    .Range("L" & NewLig).Value = IIf(Val(Sh.Range("G21").Value) <> 0, (Sh.Range("G21").Value + Sh.Range("G29").Value + Sh.Range("G33").Value), "")
    .Range("M" & NewLig).Value = IIf((Sh.Range("L45").Value) = "x" Or (Sh.Range("L45").Value) = "X", "F", Workbooks(Monfichier).Sheets(pmannee).Range("M" & NewLig).Value)
    .Range("M" & NewLig).Value = IIf((Sh.Range("L46").Value) = "x" Or (Sh.Range("L46").Value) = "X", "R", Workbooks(Monfichier).Sheets(pmannee).Range("M" & NewLig).Value)
    .Range("M" & NewLig).Value = IIf((Sh.Range("L47").Value) = "x" Or (Sh.Range("L47").Value) = "X", "E", Workbooks(Monfichier).Sheets(pmannee).Range("M" & NewLig).Value)
    .Range("S" & NewLig).Value = "Accepté"
    .Range("U" & NewLig).Value = IIf((Sh.Range("D48").Value) = "x" Or (Sh.Range("D48").Value) = "X", "", "x")
    .Range("V" & NewLig).Value = IIf((Sh.Range("D47").Value) = "x" Or (Sh.Range("D47").Value) = "X", "", "x")
    .Range("X" & NewLig).Value = IIf((Sh.Range("D50").Value) = "x" Or (Sh.Range("D50").Value) = "X", "", "x")
    .Range("Y" & NewLig).Value = IIf((Sh.Range("D51").Value) = "x" Or (Sh.Range("D51").Value) = "X", "", "x")
    .Range("A20:AZ" & NewLig).Sort Key1:=.Range("A20"), Order1:=xlAscending
 
    ElseIf pment <> "101" And pmdate = "n" And pmjustif = "o" Then
    .Range("A" & NewLig).Value = (Sh.Range("F1").Value & Sh.Range("H1").Value & Left(WorksheetFunction.Text(Sh.Range("J1").Value, "00000"), 5))
    .Range("B" & NewLig).Value = Sh.Range("B12").Value & " " & Sh.Range("B13").Value
    .Range("C" & NewLig).Value = IIf(Val(Sh.Range("C21").Value) <> 0, (Sh.Range("C21").Value + Sh.Range("C29").Value + Sh.Range("C33").Value), "")
    .Range("E" & NewLig).Value = IIf(Val(Sh.Range("E21").Value) <> 0, Sh.Range("E21").Value, "")
    .Range("H" & NewLig).Value = IIf(Val(Sh.Range("I25").Value) <> 0, Sh.Range("I25").Value, "")
    .Range("I" & NewLig).Value = IIf(Val(Sh.Range("I21").Value) <> 0, (Sh.Range("I21").Value + Sh.Range("I37").Value), "")
    .Range("J" & NewLig).Value = IIf(Val(Sh.Range("G21").Value) <> 0, (Sh.Range("G21").Value + Sh.Range("G29").Value + Sh.Range("G33").Value), "")
    .Range("K" & NewLig).Value = IIf((Sh.Range("L45").Value) = "x" Or (Sh.Range("L45").Value) = "X", "F", Workbooks(Monfichier).Sheets(pmannee).Range("K" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("L46").Value) = "x" Or (Sh.Range("L46").Value) = "X", "R", Workbooks(Monfichier).Sheets(pmannee).Range("K" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("L47").Value) = "x" Or (Sh.Range("L47").Value) = "X", "E", Workbooks(Monfichier).Sheets(pmannee).Range("K" & NewLig).Value)
    .Range("N" & NewLig).Value = "Accepté"
    .Range("P" & NewLig).Value = IIf((Sh.Range("D48").Value) = "x" Or (Sh.Range("D48").Value) = "X", "", "x")
    .Range("Q" & NewLig).Value = IIf((Sh.Range("D47").Value) = "x" Or (Sh.Range("D47").Value) = "X", "", "x")
    .Range("S" & NewLig).Value = IIf((Sh.Range("D50").Value) = "x" Or (Sh.Range("D50").Value) = "X", "", "x")
    .Range("T" & NewLig).Value = IIf((Sh.Range("D51").Value) = "x" Or (Sh.Range("D51").Value) = "X", "", "x")
    .Range("A20:AZ" & NewLig).Sort Key1:=.Range("A20"), Order1:=xlAscending
 
    ElseIf pmjustif = "p" Then
    .Range("A" & NewLig).Value = (Sh.Range("F1").Value & Sh.Range("H1").Value & Left(WorksheetFunction.Text(Sh.Range("J1").Value, "00000"), 5))
    .Range("B" & NewLig).Value = Sh.Range("H15").Value
    .Range("C" & NewLig).Value = Sh.Range("H16").Value
 
    Else
    .Range("A" & NewLig).Value = (Sh.Range("F1").Value & Sh.Range("H1").Value & Left(WorksheetFunction.Text(Sh.Range("J1").Value, "00000"), 5))
    .Range("B" & NewLig).Value = Sh.Range("B12").Value & " " & Sh.Range("B13").Value
    .Range("C" & NewLig).Value = IIf(Val(Sh.Range("C21").Value) <> 0, (Sh.Range("C21").Value + Sh.Range("C29").Value + Sh.Range("C33").Value), "")
    .Range("E" & NewLig).Value = IIf(Val(Sh.Range("E21").Value) <> 0, Sh.Range("E21").Value, "")
    .Range("H" & NewLig).Value = IIf(Val(Sh.Range("I25").Value) <> 0, Sh.Range("I25").Value, "")
    .Range("I" & NewLig).Value = IIf(Val(Sh.Range("I21").Value) <> 0, (Sh.Range("I21").Value + Sh.Range("I37").Value), "")
    .Range("J" & NewLig).Value = IIf(Val(Sh.Range("G21").Value) <> 0, (Sh.Range("G21").Value + Sh.Range("G29").Value + Sh.Range("G33").Value), "")
    .Range("K" & NewLig).Value = IIf((Sh.Range("L45").Value) = "x" Or (Sh.Range("L45").Value) = "X", "F", Workbooks(Monfichier).Sheets(pmannee).Range("K" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("L46").Value) = "x" Or (Sh.Range("L46").Value) = "X", "R", Workbooks(Monfichier).Sheets(pmannee).Range("K" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("L47").Value) = "x" Or (Sh.Range("L47").Value) = "X", "E", Workbooks(Monfichier).Sheets(pmannee).Range("K" & NewLig).Value)
    .Range("N" & NewLig).Value = "Accepté"
    .Range("A20:AZ" & NewLig).Sort Key1:=.Range("A20"), Order1:=xlAscending
 
    End If
 
End With
    wb.Save
    wb.Close
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="\\SVIMP\Copieur"
    Sh.Range("R5").Value = Sh.Range("J1").Value
    ThisWorkbook.Sheets("Plan").Range("J1").MergeArea.ClearContents
Rows("25:26").Hidden = False
Rows("27:28").Hidden = True
Rows("29:30").Hidden = False
Rows("31:32").Hidden = True
Rows("33:34").Hidden = False
Rows("35:36").Hidden = True
Rows("37:38").Hidden = False
Rows("39:40").Hidden = True
End If
 
ElseIf pmcopie = "n" Then
mafinimpr:
Dim Sh2 As Worksheet
Set Sh2 = ThisWorkbook.Sheets("Plan")
    If (Val(Sh2.Range("C25").Value) = 0 Or (Sh2.Range("C25").Value) = "") Then
    Rows("25:26").Hidden = True
    Rows("27:28").Hidden = False
    End If
    If (Val(Sh2.Range("C29").Value) = 0 Or (Sh2.Range("C29").Value) = "") Then
    Rows("29:30").Hidden = True
    Rows("31:32").Hidden = False
    End If
    If (Val(Sh2.Range("C33").Value) = 0 Or (Sh2.Range("C33").Value) = "") Then
    Rows("33:34").Hidden = True
    Rows("35:36").Hidden = False
    End If
    If (Val(Sh2.Range("C37").Value) = 0 Or (Sh2.Range("C37").Value) = "") Then
    Rows("37:38").Hidden = True
    Rows("39:40").Hidden = False
    End If
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="\\SVIMP\Copieur"
Sh2.Range("R5").Value = Sh2.Range("J1").Value
ThisWorkbook.Sheets("Plan").Range("J1").MergeArea.ClearContents
mafin:
Rows("25:26").Hidden = False
Rows("27:28").Hidden = True
Rows("29:30").Hidden = False
Rows("31:32").Hidden = True
Rows("33:34").Hidden = False
Rows("35:36").Hidden = True
Rows("37:38").Hidden = False
Rows("39:40").Hidden = True
End If
Set Sh = Nothing
Set Sh2 = Nothing
Set wb = Nothing
pasretry:
Application.ScreenUpdating = True
End If
End Sub
Je suis novice en VBA alors ne pas trop critiquer mon code... lol il n'est surement pas très optimisé mais pour l'instant il fonctionne !

Mon problème, c'est que je souhaite remplacer les msgbox par des userform ils sont plus personnalisable que les msgbox.

Mais je n'arrive pas a récupérer le choix du clic de la personne exemple quand le fichier est ouvert si la personne clic "recommencer" il relance la procédure du 1er bouton avec mon goto retry:

Pas certain d'être clair...

Une explication de mon code, les personnes remplissent certaines cellules d'une feuille excel, puis en appuyant sur le bouton sur la feuille, ca recopie les données dans un autre fichier excel (pour éviter une recopie inutile) et lance une impression en même temps de la feuille en pochette sur notre copieur.

Et suivant certain cas ca ne récupère pas toutes les cellules, certain fichier étant différent... !

Mais ma question n'est pas la, c'est sur les userform

d'avance merci.