ouvrir une fichier via boîte de dialogue

Sub OuvrirClasseur()
ChDir ThisWorkbook.Path & "\"
Application.Dialogs(xlDialogOpen).Show
End Sub

Sub Import_Nmoins2()

Dim cl As Range
Dim str As Variant
Dim ok As Boolean
'
'On teste si il n'y a pas de cellule vide dans la plage
'Si une cellule est vide on informe l'utilisateur et on sort de la procédure
For Each cl In Worksheets("Accueil").Range("B9")
   If cl.Value = "" Then
      MsgBox "L'année de référence n'est pas renseignée", vbExclamation, "Message Erreur"
      cl.Activate
      Exit Sub
   End If
Next cl


 'Suppression de l'affichage des calculs
    Application.ScreenUpdating = False
    
Dim a As Variant, b As Variant, Nom As String, Nom2 As String

Nom = ActiveWorkbook.Name
ChDrive "C:" ' Choix du lecteur
ChDir "C:\" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", _
, "Sélection de vos fichiers excel", , True)

Select Case TypeName(a)
Case Is = "Boolean"
Exit Sub
Case Else
For b = LBound(a) To UBound(a)
Workbooks.Open a(b)
Next
End Select

Nom2 = ActiveWorkbook.Name
Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
Windows(Nom).Activate
Sheets("JC N-2 par mission").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

 Application.DisplayAlerts = False
    Windows(Nom2).Close
    Application.DisplayAlerts = True
    
    Sheets("Accueil").Activate
     
     'Suppression de l'affichage des calculs
    Application.ScreenUpdating = True

End Sub

Dim Chemin
    
    Chemin = Application.GetOpenFilename("*.*, *.*")
    ChDrive "D"
    ChDir ("D:\Dossiers Excel\The Best Of VBA\Carnet d'adresses\")
    
    If VarType(Chemin) <> 11 Then
For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) Then
                      Chaine = Chaine & " " & ListBox1.List(i) & ";"
            End If
      Next i
  
    Set olApp = CreateObject("Outlook.Application")
    Set objMail = olApp.CreateItem(olMailItem)
    
    With objMail
    .To = Nouveau.Email.Value
    .cc = ""
    .BCC = Trim(Chaine)
    .Subject = ""
    .Body = ""
    .Attachments.Add Chemin
    .Display
    End With
End if

Dim Chemin As String
Dim BdOpen
   
      Chemin = ThisWorkbook.Path & "\"
       BdOpen = Application.Dialogs(xlDialogOpen).Show(Chemin)

    If VarType(BdOpen) <> False Then
      Exit Sub
      End If

Private Sub Envois_Click()
Dim i As Byte
Dim olApp, objMail
Dim olmail As MailItem
Dim Chaine As String, OpenFolder
   
    ChDrive "D"
    ChDir ThisWorkbook.Path & "\"
    OpenFolder = Application.GetOpenFilename("(*.*),*.*")
    
    For i = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(i) Then
            Chaine = Chaine & " " & ListBox1.List(i) & ";"
        End If
      Next i
  
    Set olApp = CreateObject("Outlook.Application")
    Set objMail = olApp.CreateItem(olMailItem)
    
    With objMail
    .To = Nouveau.Email.Value
    .cc = ""
    .BCC = Trim(Chaine)
    .Subject = ""
    .Body = ""
    If OpenFolder <> False Then .Attachments.Add OpenFolder
    .Display
    End With
End Sub

Sub Import_Nmoins2()
‘pas besoin d’une boucle pour 1 cas  
  Dim cl As Range
  Set cl = Worksheets("Accueil").Range("B9")
  If cl = "" Then
    MsgBox "L'année de référence n'est pas renseignée", vbExclamation, "Message Erreur"
    cl.Select : Exit Sub
  End If
‘suite 
   Application.ScreenUpdating = False
   Dim a, Nom As String, Nom2 As String
   Nom = ActiveWorkbook.Name
   ChDrive "…" 'Choix du répertoire à ouvrir !
   a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", , _
        "Sélection de vos fichiers excel", , True)
   If UBound(a) = 0 Then Exit Sub
   Workbooks.Open a(1)
   Nom2 = ActiveWorkbook.Name
   Range("A1").CurrentRegion.Copy
   Windows(Nom).Activate 'activation du classeur appelant
   Sheets("JC N-2 par mission").Select 'onglet dans le classeur appelant
   Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False  Application.DisplayAlerts = False
   Windows(Nom2).Close
   Application.DisplayAlerts = True
   Sheets("Accueil").Activate
   MsgBox "mission accomplie"
End Sub