Gestionnaire de fichier et File Picker

Bonjour tout le monde,

Le programme ci-dessous me permet de sélectionner un Excel et de copier coller ses données ainsi que le chemin d'accès et son nom sur l'Excel en cours d'utilisation.

Mon problème est que je dois ouvrir deux fois le gestionnaire de fichier. Une fois pour copier et coller les données. Une seconde fois coller le chemin d'accès et le nom du fichier sélectionné.

Est-il possible d'ouvrir qu'une seule fois le gestionnaire de fichier ? Si oui, comment le faire ?

Sub Bouton1_Cliquer()

Dim FichierSource As Variant
Dim WbSource As Workbook
Dim ShCible As Worksheet
Dim strFichier As String
Dim strCheminEtFichier As String

    On Error GoTo Fin

    Set ShCible = Sheets("Feuil2")
    FichierSource = Application.GetOpenFilename
    If FichierSource = False Then GoTo Fin

    Application.ScreenUpdating = False
    Set WbSource = Workbooks.Open(FichierSource)
    With WbSource
         .Sheets(1).Range("A3:G101").Copy
         ShCible.Range("A3").PasteSpecial Paste:=xlPasteValues
         Application.CutCopyMode = False
         .Close False
    End With

    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        On Error Resume Next
        strCheminEtFichier = .SelectedItems.Item(1)
        strFichier = Right(strCheminEtFichier, Len(strCheminEtFichier) - InStrRev(strCheminEtFichier, "\"))
        On Error GoTo 0
    End With
    If strCheminEtFichier <> "" Then
        Range("Test2").Value = strFichier
        Range("Test").Value = strCheminEtFichier
    End If

    Application.ScreenUpdating = True
    Sheets("Feuil1").Activate
    GoTo Fin

Fin:

    Application.ScreenUpdating = True

    Set ShCible = Nothing
    Set WbSource = Nothing

End Sub

bonjour,

une solution possible

Sub Bouton1_Cliquer()

    Dim FichierSource As Variant
    Dim WbSource As Workbook
    Dim ShCible As Worksheet
    Dim strFichier As String
    Dim strCheminEtFichier As String

    Set ShCible = Sheets("Feuil2")

    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show Then
            strCheminEtFichier = .SelectedItems.Item(1)
            strFichier = Right(strCheminEtFichier, Len(strCheminEtFichier) - InStrRev(strCheminEtFichier, "\"))
            Range("Test2").Value = strFichier
            Range("Test").Value = strCheminEtFichier
        Else
        MsgBox "pas de fichier sélectionné"
            GoTo Fin
        End If
    End With
    Application.ScreenUpdating = False
    Set WbSource = Workbooks.Open(strCheminEtFichier)
    With WbSource
        .Sheets(1).Range("A3:G101").Copy
        ShCible.Range("A3").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        .Close False
    End With

Fin:

    Application.ScreenUpdating = True

    Set ShCible = Nothing
    Set WbSource = Nothing

End Sub

Bonjour à tous

juste en passant

1. perso je n'aime pas trop les goto (jouent trop souvent des tours ces cochonneries)
2. je préfère la boite de dialogue vba "GetOpenFileName"
3. on sort directe si on a annulé
4. la fonction Mid avec InstrRev suffit a chopper le nom du fichier
5. on crée les object uniquement si un fichier a été sélectionné
6. et par conséquent on a à les détruire uniquement si un fichier a été sélectionné
7. je ne copy/paste pas(même avec (Pastespecial) mais ; plage receptrice. value =plage source . value c'est toutsurtout que c'est la même visiblement
8. c'est propre et net

Sub Bouton1_Cliquer()

    Dim FichierSource, WbSource As Workbook, ShCible As Worksheet, strFichier$, strCheminEtFichier

    strCheminEtFichier = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "OUVRIR UN FICHIER EXCEL")

    If strCheminEtFichier = False Then MsgBox "pas de fichier sélectionné": Exit Sub

             strFichier = Mid(strCheminEtFichier, InStrRev(strCheminEtFichier, "\") + 1)

            Application.ScreenUpdating = False
            Range("Test2").Value = strFichier
            Range("Test").Value = strCheminEtFichier

            Set WbSource = Workbooks.Open(strCheminEtFichier)
            Set ShCible = ThisWorkbook.Sheets("Feuil2")

            ShCible.Range("A3:G101").Value = WbSource.Sheets(1).Range("A3:G101").Value
            WbSource.Close False

            Application.ScreenUpdating = True
            Set ShCible = Nothing
            Set WbSource = Nothing
End Sub

Bonjour, merci pour vos solutions. Le programme fonctionne comme souhaité.