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
196
197
198
199
200
201
202
203
| 'Public ClasseurOuv As String
'Public ClasseurOrg As String
Private ClasseurOuv As Workbook 'Public les rend accessible depuis un autre module ou UserForm, ce qui n'est pas utile ici
Private ClasseurOrg As Workbook 'Autant gerer tes classeur directement plutot que de garder uniquement leur nom
Public Sub Copier_Click()
'=macro de copiage des feuilles du classeur ouvert vers le classeur d'origine=
'Pourquoi declarer ses variable au niveau du module?
Dim i As Integer
Dim FeuilleOrg As String
Dim liste_feuilles() As String, taille_tableau As Integer
Application.ScreenUpdating = False
'Application.DisplayAlerts = False 'ca vaut mieux le mettre une fois l'application correctement debuggé et encore il vaut mieux faire une gestion d'erreur plutot que de cacher a l'utilisateur le pourquoi du plantage de son excel
'== on défini la feuille du classeur d'origine qui servira de repère au moment de la copie ==
'With UsfImport.ListeOrg
'For i = 0 To .ListCount - 1
'If .Selected(i) Then
'FeuilleOrg = .List(i)
'Exit For
'End If
'Next i
'End With
If ListeOrg.ListIndex <> -1 Then 'on s'assure qu'un element est selectionné
FeuilleOrg = ListeOrg.List(ListeOrg.ListIndex)
Else
'Gerer ici le fait que l'utilisateur n'est pas choisi de feuil
'Par exemple on choisi la 1er feuil
FeuilleOrg = ListeOrg.List(0)
End If
'On s'assure qu'au moins une feuille est ete selectionné dans la 1er listbox
If Liste.ListIndex = -1 Then
'Pas de feuill a copier on sort
MsgBox "choisir des feuilles a copier"
Exit Sub
End If
'== on rempli la variable tableau avec les items sélectionnés dans la liste de gauche ==
With UsfImport.Liste
ReDim liste_feuilles(0)
For i = 0 To .ListCount - 1
If .Selected(i) Then
'On redimmenssionne
ReDim Preserve liste_feuilles(UBound(liste_feuilles) + 1)
liste_feuilles(UBound(liste_feuilles) - 1) = .List(i)
'On Error Resume Next
'taille_tableau = UBound(liste_feuilles)
'If Err.Number <> 0 Then
'taille_tableau = 0
'ReDim liste_feuilles(0)
'Err.Clear
'Else
'taille_tableau = taille_tableau + 1
'ReDim Preserve liste_feuilles(taille_tableau)
'End If
'liste_feuilles(taille_tableau) = Sheets(.List(i)).Name 'Tu as deja le nom de la sheet dans list(i), pourquoi la transformer en sheet, pour ensuite en resortir le nom?
'On Error GoTo 0
End If
Next i
'On supprime le morceau de tableau en trop
ReDim Preserve liste_feuilles(UBound(liste_feuilles) - 1)
End With
'== on vérifie que l'utilisateur a bien choisi où il voulait copier ses feuilles == 'il vaudrait mieux faire cela avant de remplire la moitier de tes variables
If Not (Avant.Value) And Not (Apres.Value) Then 'Le mieux serait peut etre d'en mettre un par defaut
MsgBox ("Veuillez précisez à quel endroit du classeur voulez-vous copier les feuilles sélectionnées")
Avant.SetFocus
Exit Sub
End If
'== PROVISOIRE == on regarde ce qu'il y a dans la variable tableau ==
'MsgBox Join(liste_feuilles, vbLf)
'== si on choisi de copier avant ==
If Avant.Value Then 'le "= true" est facultatif on test deja une valeur boolean avec le If
'Sheets(liste_feuilles).Copy before:=Workbooks(ClasseurOrg).Sheets(FeuilleOrg)
Sheets(liste_feuilles).Copy before:=ClasseurOrg.Sheets(FeuilleOrg)
'on copie les éléments de la variable tableau
'== idem si on choisi de copier après ==
ElseIf Apres.Value = True Then
'Sheets(liste_feuilles).Copy after:=Workbooks(ClasseurOrg).Sheets(FeuilleOrg)
Sheets(liste_feuilles).Copy after:=ClasseurOrg.Sheets(FeuilleOrg)
End If
'réactualisation de la liste des feuilles du classeur d'origine 'Inutil ce sera fait lors de l'appel a Initialize si l'utilisateur desir recommencer une copie
'With Workbooks(ClasseurOrg)
With ClasseurOrg
UsfImport.ListeOrg.Clear
For i = 1 To .Sheets.Count
UsfImport.ListeOrg.AddItem .Sheets(i).Name
Next i
End With
'on pose la question d'une autre copie
Select Case MsgBox("Autre copie ?", vbQuestion + vbYesNo)
Case vbYes 'si oui on sort en laissant tout ouvert
'Exit Sub 'attention avec les exit Sub, le code qui suit n'est jamais executé, y compris les 2 ligne de la fin qui remettent screenupdating et DisplayAlerte a true
Case vbNo 'si non on ferme tout en réinitalisant les listes
'Workbooks(ClasseurOuv).Close
ClasseurOuv.Close
'UsfImport.
Liste.Clear
'UsfImport.
ListeOrg.Clear
UsfImport.Hide
'Exit Sub 'attention avec les exit Sub, le code qui suit n'est jamais executé, y compris les 2 ligne de la fin qui remettent screenupdating et DisplayAlerte a true
End Select
'Inutile de mettre 2 fois le meme code a la fois dans le If et dans le ElseIf, il sera executé dans les 2 cas, donc autant l'executer apres le If ElseIf End If
'réactualisation de la liste des feuilles du classeur d'origine
'Workbooks(ClasseurOrg).Activate
'UsfImport.ListeOrg.Clear
'For i = 1 To Sheets.Count
' UsfImport.ListeOrg.AddItem Sheets(i).Name
'Next i
' Select Case MsgBox("Autre copie ?", vbQuestion + vbYesNo)
' Case vbYes
' Exit Sub
' Case vbNo
' Workbooks(ClasseurOuv).Close
' UsfImport.Liste.Clear
' UsfImport.ListeOrg.Clear
' UsfImport.Hide
' Exit Sub
' End Select
'End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub UserForm_Activate()
Dim Chemin As Variant
Dim Ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'UsfImport.
Liste.Clear
'UsfImport.
ListeOrg.Clear
Set ClasseurOrg = ActiveWorkbook ' .Name 'On pointe directement le WorkBook
For i = 1 To Sheets.Count
'UsfImport.ListeOrg.AddItem Sheets(i).Name'Inutil de preciser le nom du UserForm
ListeOrg.AddItem Sheets(i).Name
Next i
Chemin = Application.GetOpenFilename("Classeurs Microsoft Exel(*.xls),*.xls")
If Chemin = False Then
UsfImport.Hide
Exit Sub
End If
'Workbooks.Open Chemin
'ClasseurOuv = ActiveWorkbook.Name
'Attention si le classeur est deja ouvert ca bugg faut faire une gestion d'erreur
Set ClasseurOuv = Workbooks.Open(Chemin)
For i = 1 To Sheets.Count
'UsfImport.Liste.AddItem ClasseurOuv.Sheets(i).Name 'Inutil de preciser le nom du UserForm
Liste.AddItem ClasseurOuv.Sheets(i).Name
Next i
'UsfImport.
Classeur.Value = ClasseurOuv.Name 'on rajoute .name ici , puisque ClasseurOuv n'est plus une string, mais directement e classeur lui meme
'UsfImport.
Origine.Value = ClasseurOrg.Name
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub |
