Variable tableau vide

**buhrne** · 20/03/2009, 18h55

Bonjour,

Voici mon pb : j'utilise dans un userform 2 listbox alimentées par le nom des feuilles du classeur (ClasseurOrg) pour l'un et par les noms des feuilles d'un autre classeur ouvert par GetOpenFilename (ClasseurOuv).

J'utilise ensuite une variable tableau pour sélectionner les feuilles que l'ont veut copier du classeur ouvert vers le classeur d'origine.

Au premier passage ça fonctionne impec.
Seulement une fois la copie effectuée, je demande par le biais d'une msgbox si l'utilisateur veut faire une autre copie.

Si non, je ferme tous les classeurs et cache le usf.

Si oui, je quitte la sub en laissant tous les classeurs ouverts et les listes remplies pour un nouveau copiage.
L'utilisateur peut alors choisir les nouvelles pages à copier et l'endroit.
Seulement le pb commence ici.

La boucle remplissant ma variable tableau avec les items selectionnés de la listbox ne fais plus son office. La variable tableau est bien redimensionnée selon le nombre d'items choisis mais ces items sont vides dans la variable. Ce qui fait qu'ensuite, quand je demande de collé les éléments de ma variable, ça plante. SAUF si je choisi les mêmes items que lors de la précedente copie !!!

Voici le code incriminé. Je vous met aussi le classeur en question en pièce jointe, le code se trouve dans le usf.

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
 
Public i As Integer
Public ClasseurOuv As String
Public ClasseurOrg As String
Public FeuilleOrg As String
 
Public Sub Copier_Click()
'=macro de copiage des feuilles du classeur ouvert vers le classeur d'origine=
 
 
Dim liste_feuilles() As String, taille_tableau As Integer
 
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'== 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
 
 
'== on rempli la variable tableau avec les items sélectionnés dans la liste de gauche ==
With UsfImport.Liste
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
            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
            On Error GoTo 0
            End If
        Next i
End With
 
 
'== on vérifie que l'utilisateur a bien choisi où il voulait copier ses feuilles ==
If Avant.Value = False And Apres.Value = False Then
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 = True Then
Sheets(liste_feuilles).Copy before:=Workbooks(ClasseurOrg).Sheets(FeuilleOrg)
'on copie les éléments de la variable tableau
 
'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
 
'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
 
        Case vbNo   'si non on ferme tout en réinitalisant les listes
            Workbooks(ClasseurOuv).Close
            UsfImport.Liste.Clear
            UsfImport.ListeOrg.Clear
            UsfImport.Hide
            Exit Sub
    End Select
 
'== idem si on choisi de copier après ==
ElseIf Apres.Value = True Then
Sheets(liste_feuilles).Copy after:=Workbooks(ClasseurOrg).Sheets(FeuilleOrg)
 
'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
 
 
 
ClasseurOrg = ActiveWorkbook.Name
 
For i = 1 To Sheets.Count
    UsfImport.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
 
For i = 1 To Sheets.Count
    UsfImport.Liste.AddItem Sheets(i).Name
Next i
 
UsfImport.Classeur.Value = ClasseurOuv
UsfImport.Origine.Value = ClasseurOrg
 
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Si quelqun voit ce qui se passe. Merci d'avance

**Qwazerty** · 20/03/2009, 23h37

Salut
Tiens regardes les sque j'ai apporté, j'y ai passé beaucoup de temps et du coup j'ai pas regardé si ça buggé toujours.

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
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

a++
Qwaz

Variable tableau vide

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager