[B]Controle avant d'ouvrir et copier d'un autre classeur[/B]

[yakin78]

Bonjour à tous

J'aimerai faire un controle sur une ouverture de fichier d'un autre classeur avant de copier la cellule,
si la feuille du classeur externe est nommée différent de Sheets("Externe") alors MsgBox( "mauvais Classeur")
et sortir de la boucle

Private Sub Transfert_Click()
    
Dim ligne As Integer
Dim I As Integer
     ligne = 2
     Cheminfichier = Application.GetOpenFilename("Fichiers Excels (*.xlsx), *.xlsx")
If Cheminfichier = False Then
    MsgBox ("Copie annulé")
Exit Sub
End If
                  
        Workbooks.Open Cheminfichier
For I = Len(Cheminfichier) To 1 Step -1
If Mid(Cheminfichier, I, 1) = "\" Then Exit For
Next
        nomfichier = Mid(Cheminfichier, I + 1, Len(Cheminfichier))
        ThisWorkbook.Sheets("Local").Range("A1") = Workbooks(nomfichier).Sheets("Externe").Range("A1").Value
         Workbooks(nomfichier).Close
         ligne = ligne + 1

         MsgBox ("Copie effectué avec succes !!")
         
End Sub

ce bout de code je l'ai trouvé dans ce forum
merci d'avance !!

 

[job75]

Re : Controle avant d'ouvrir et copier d'un autre classeur

Bonjour yakin78,

(...) et sortir de la boucle

Quelle boucle ???

Bien maladroit le code pour trouver le nom du fichier...

A+

 

[Theze]

Re : Controle avant d'ouvrir et copier d'un autre classeur

Bonjour,

Teste ce qui suit (fonction de contrôle avant ouverture) :

Private Sub Transfert_Click()

    Dim T() As String
    Dim Existe As Boolean
    Dim Cheminfichier
    Dim nomfichier As String
    Dim ligne As Integer
    Dim I As Integer

     ligne = 2
     Cheminfichier = Application.GetOpenFilename("Fichiers Excels (*.xlsx), *.xlsx")
     
    If Cheminfichier = False Then
    
        MsgBox ("Copie annulée !")
        Exit Sub
    
    End If
    
    'récupère les noms des feuilles
    If FeuilleExiste(Cheminfichier, "Externe") = False Then
        
        MsgBox "Pas le bon classeur ! :o("
        Exit Sub
        
    End If
                  
    Workbooks.Open Cheminfichier
    
    'c'est plus simple de cette façon pour récupérer seulement le nom du fichier
    nomfichier = Dir(Cheminfichier)
        
    ThisWorkbook.Sheets("Local").Range("A1") = Workbooks(nomfichier).Sheets("Externe").Range("A1").Value
    Workbooks(nomfichier).Close
    ligne = ligne + 1
    
    MsgBox ("Copie effectué avec succès !!")
         
End Sub

Function FeuilleExiste(Fichier, NomFeuille As String) As Boolean

    Dim Cat As Object
    Dim tbl As Object
    
    Set Cat = CreateObject("ADOX.Catalog")
   
    Cat.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                       Fichier & _
                       ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=2;"""
    
    Set tbl = CreateObject("ADOX.Table")
    
    FeuilleExiste = False
    
    For Each tbl In Cat.Tables
        
        If Replace(tbl.Name, "$", "") = NomFeuille Then
        
            FeuilleExiste = True
            Exit For
            
        End If
    Next

End Function

Hervé.

 

[job75]

Re : Controle avant d'ouvrir et copier d'un autre classeur

Salut Theze,

Evidemment si l'on teste après l'ouverture du fichier c'est plus facile :

Workbooks.Open cheminfichier
nomfichier = Dir(cheminfichier)
On Error Resume Next
If IsError(Workbooks(nomfichier).Sheets("Externe")) Then
  MsgBox "Mauvais fichier !"
  Workbooks(nomfichier).Close
  Exit Sub
End If
'suite du code

A+

 

[yakin78]

Re : Controle avant d'ouvrir et copier d'un autre classeur

Bonjour
et merci Job75 et Theze !! j'ai pris celui de Job75 ,plus court ,ca marche nickel !!

en fait je voulais dire sortir de la procedure !!