Bonjour,
J’ai réalisé un macro VBA qui consiste à aller ouvrir dans un repertoire tous les fichiers excel possèdant la feuille “SQL” et copier le contenu dans un fichier texte au même endroit et sous le même nom que le fichier d’origine.
Cependant ma macro ne va pas chercher les fichiers situés dans les sous dossiers.
Quelqu’un pourrai m’aider le code est le suivant :
`Sub Trans_Fichier_Texte()
'|||||||||||||||||||||||||||||||Partie Déclarations des variables|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Dim Boite_dialogue As FileDialog 'variable BDD (Boîte de Dialogue Dossier)
Dim Chemin_Dossier As String 'variable chemin_Dossier (Chemin d’Accès)
Dim Repertoire As Workbook 'variable repertoire
Dim Fichier_parcouru As String 'variable Fichier selectionne correspond au fichier définit par (Fichier Source)
Dim Classeur As Workbook 'variable CS (Classeur Source)
Dim start As Single
Dim Chemin_Fichier As String
Dim Feuille As String
Dim F As Integer
Dim Nom_Fichier As String
Dim Nom_Fichier_MAJ As String
Dim FSO As Object
'|||||||||||||||||||||||||||||||Partie Choix du repertoire||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
MsgBox " Vous allez choisir le répetoire d’exécution ", vbOKOnly + vbInformation, “Faîtes le bon choix”
'définit la boîte de dialogue BDD (permetant de définir le dossier des fichiers source)
Set Boite_dialogue = Application.FileDialog(msoFileDialogFolderPicker)
With Boite_dialogue 'prend en compte BDD
.AllowMultiSelect = True 'n’autorise qu’une seule sélection
.Show 'affiche Boite de dialogue
If .SelectedItems.Count = 0 Then Exit Sub 'si bouton [Annuler], sort de la procédure
Chemin_Dossier = .SelectedItems(1) & “” 'définit le chemin d’accès chemin aux fichiers à ouvrir
End With 'fin de la prise en compte de la boite de dialogue
Set Repertoire = ThisWorkbook 'définit la classeur destination CD
Fichier_parcouru = Dir(Chemin_Dossier & “.x”) 'définit le premier fichier source Excel contenu dans le dossier ayant comme chemin d’accès
'|||||||||||||||||||||||||||||||Partie transformation fichier excel en fichier texte||||||||||||||||||||||||||||||||||||||
start = Timer
'desactive le rafraichissmeent de l’ecran et accelère le processus
Application.ScreenUpdating = False
'Boucle Do while permettant de parcourir les fichiers un par un et de lui appliquer la macro Fichier_MAJ tant qu’il trouvera un fichier source dans le repertoire
Do While Fichier_parcouru <> “”
Workbooks.Open Chemin_Dossier & Fichier_parcouru 'Selectionne le fichier source
Set Classeur = ActiveWorkbook 'définit le classeur parcouru
If Verif_feuille("SQL") Then
'C'est le chemin complet du fichier à ouvrir.
Chemin_Fichier = ActiveWorkbook.Path
'Attribution du nom du fichier ouvert à Fichier_name
Nom_Fichier = ActiveWorkbook.Name
'Nom du fichier sans l'extenction
ext = InStr(StrReverse(Nom_Fichier), ".")
Nom_Fichier_MAJ = Left(Nom_Fichier, Len(Nom_Fichier) - ext)
'La macro active la feuille nommée "SQL
Feuille = ActiveWorkbook.Worksheets("SQL").Activate
'FreeFile permet de fournir un numéro de fichier qui n’est pas déjà en cours d’utilisation.
F = FreeFile
' On créé un fichier texte avec le même nom que le fichier excel
Open Chemin_Fichier & "\" & Nom_Fichier_MAJ & ".txt" For Output As #F 'Output : écriture avec effacement du fichier à chaque ouverture.
' boucle For Next pour parcourir les cellules de la feuille active et les stocker dans le fichier texte
For i = 1 To 2
Print #F, Cells(i, 1)
Next
Close #F
Classeur.Close False 'ferme le classeur (sans enregistrer)
Fichier_parcouru = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès
Else
Classeur.Close False 'ferme le classeur parcouru (sans enregistrer)
Fichier_parcouru = Dir 'définit le prochain fichier source excel du dossier ayant comme chemin d'accès
End If
Loop
'|||||||||||||||||||||||||||||||Partie Annonce du résultat||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
MsgBox "Les codes SQL ont bien été copiés dans des fichiers texte ! ", vbOKOnly + vbInformation, “Informations”
MsgBox “durée du traitement: " & Timer - start & " secondes”
End Sub
'|||||||||||||||||||||||||||||||Partie Fonction ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Function Verif_feuille(NomF As String) As Boolean ’ test si la feuille existe
On Error Resume Next 'permet d’ignorer les erreurs de la procédure
Verif_feuille = Not Sheets(NomF) Is Nothing
End Function
Cordialement,
je ne connais pas la limite)
), pareil pour mettre un truc dans une case d’excel, pareil pour gestion des macros/case cliquable… mais bon cela servira peut être un jour cela