Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

yakin78

XLDnaute Junior
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



Code:
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 !!
 

Theze

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

Bonjour,

Teste ce qui suit (fonction de contrôle avant ouverture) :
Code:
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

XLDnaute Barbatruc
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 :

Code:
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+
 
Dernière édition:

Discussions similaires

Réponses
7
Affichages
512
Réponses
4
Affichages
401
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…