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 !

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 i

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

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 !

Rechercher des sujets similaires à "vba probleme boucle filedialog"