VBA Problème boucle + .FileDialog
Bonjour à tous !
Je vous explique mon problème :
Je veux faire un algorithme qui va me permettre de sélectionner plusieurs fichiers (un à la fois) pour récupérer des données dessus. Dans l'algorithme que j'aurai après, je rajouterai plus tard un call de fonction, mais il faudrait déjà que le début marche.
Application.ScreenUpdating = False
Application.Cursor = xlWait
Critere2 = InputBox("Quel est le Périmètre ?", "PERIMETER_LEVEL_0_ID", 2160)
For i = 1 To 8
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
strFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Set wbsrc = Workbooks.Open(strFileName)
Else
MsgBox "La procédure est annulée car aucun fichier n'a été entré."
End If
ActiveSheet.Unprotect Password:="COO"
Set ws = wbsrc.Worksheets(1)
If i = 7 Then
ws.Range("A1:BG30000").AutoFilter Field:=6, Criteria1:="Change"
ws.Range("A1:BG30000").AutoFilter Field:=21, Criteria1:=Critere2
ws.Range("A1:CA30000").Copy
ElseIf i = 8 Then
ws.Range("A1:BG30000").AutoFilter Field:=6, Criteria1:="Rate"
ws.Range("A1:BG30000").AutoFilter Field:=21, Criteria1:=Critere2
ws.Range("A1:CA30000").Copy
ElseIf i = 1 Or i = 2 Then
ws.Range("A1:BG30000").AutoFilter Field:=20, Criteria1:=Critere2
ws.Range("A1:CA30000").Copy
ElseIf i = 5 Then
ws.Range("A1:BG30000").AutoFilter Field:=21, Criteria1:=Critere2
ws.Range("A1:BG30000").AutoFilter Field:=6, Criteria1:="Change"
ws.Range("A1:CA30000").Copy
ElseIf i = 6 Then
ws.Range("A1:BG30000").AutoFilter Field:=21, Criteria1:=Critere2
ws.Range("A1:BG30000").AutoFilter Field:=6, Criteria1:="Rate"
ws.Range("A1:CA30000").Copy
ElseIf i = 3 Or i = 4 Then
ws.Range("A1:CA30000").Copy
End If
Set ws = wbtrg.Worksheets("Feuille" & i) ' coller le resultat dans la feuil source du fichier destinataire
ws.Range("A1").PasteSpecial xlPasteAll
ws.Columns("A:CG").ColumnWidth = 15
ws.Rows("1:1").RowHeight = 70
ws.Rows("2:100").RowHeight = 15
Set ws = Nothing
Application.DisplayAlerts = False
wbsrc.Close savechanges:=False ' fermer le fichier source
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wbsrc = Nothing
Set wbtrg = Nothing
Application.Cursor = xlDefault
Application.EnableEvents = True
Next i J'utilise donc un .FileDialog dans une boucle i allant de 1 à 6. Néanmoins, au moment d'arriver à Workbooks.Open, ca ouvre le fichier mais ca me redemande ensuite d'ouvrir un autre fichier, et cela avant que cela lise la suite du code !
Comment faire pour que l'algorithme s'effectue entièrement puis ne me demande qu'ensuite le prochain fichier ?
Merci d'avance pour votre aide !
- Messages
- 4'199
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Ceci devrait être mieux et je vous conseille d'indenter correctement votre code pour une meilleure lisibilité.
Application.ScreenUpdating = False
Application.Cursor = xlWait
Critere2 = InputBox("Quel est le P?rim?tre ?", "PERIMETER_LEVEL_0_ID", 2160)
For i = 1 To 8
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
intChoice = .Show
If intChoice <> 0 Then
strFileName = .SelectedItems(1)
Set wbsrc = Workbooks.Open(strFileName)
Else
MsgBox "La procédure est annulée car aucun fichier n'a été entré."
End If
End With
'........................................
Next iMerci de ta réponse !
Mais malheureusement cela n'a pas résolu mon problème. Quand j'utilise le débogage c'est la ligne set wbsrc = Workbooks.Open(strFileName) qui fait rouvrir la fenêtre de demande d'un fichier !
- Messages
- 4'199
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
J'ai retesté le code que j'ai soumis et je n'ai pas de problème.
Ce qui n'allait pas dans ton code initial, c'était cette instruction :
strFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)qui provoquait une nouvelle demande d'ouverture.
En effet, c'est bon ! C'est juste que dans le débogage cela ne permettait pas de "lire" chaque ligne qui suivait, mais cela marchait quand meme !
Merci beaucoup pour ton aide !