Demande de soutien en vba Excel
STEPH
-
Le Pingou Messages postés 12644 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12644 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour à tous,
Je suis débutant en vba . Il m'a été demandé de faire une macro qui va permettre à l'utilisateur de saisir un terme, ensuite ce terme est rechercher dans plusieurs fichiers .xlsx contenus dans un dossier. si le terme est trouvé, la ligne est copiée dans une feuille Excel autant de fois que le terme est trouvé. Vraiment j'ai besoin de l'aide
Je suis débutant en vba . Il m'a été demandé de faire une macro qui va permettre à l'utilisateur de saisir un terme, ensuite ce terme est rechercher dans plusieurs fichiers .xlsx contenus dans un dossier. si le terme est trouvé, la ligne est copiée dans une feuille Excel autant de fois que le terme est trouvé. Vraiment j'ai besoin de l'aide
A voir également:
- Demande de soutien en vba Excel
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Mise en forme conditionnelle excel - Guide
- Déplacer colonne excel - Guide
- Si ou excel - Guide
3 réponses
Voici ce que j'ai fait:
'Le premier bouton
'Le premier bouton
Private Sub dossier_Click()
Dim bDialogue As Office.FileDialog
Dim chDossier As String
'Choix du chemin
Set bDialogue = Application.FileDialog(msoFileDialogFolderPicker)
bDialogue.Title = "Sélectionner un dossier à parcourir"
'Vérification pour voir si le chemin a été choisi
If bDialogue.Show = -1 Then
chDossier = bDialogue.SelectedItems(1)
Range("B5").Value = chDossier
End If
End Sub
'Le deuxième bouton
Private Sub recherche_Click()
If (Range("B5").Value = "") Then
MsgBox ("Vous devez désigner un dossier à parcourir avec le premier bouton")
Exit Sub
End If
If (Range("B8").Value = "") Then
MsgBox ("Vous devez spécifier un terme à remplacer")
Exit Sub
End If
'La procedure de nettoyage la plage qui va recevoir la copie
nettoyer
'Procedure de traitement des fichiers
parcourirLesFichiers
End Sub
Sub nettoyer()
'Une procedure qui permet de vider les cellules à partir de la ligne 11,colonne 2 à 6
Dim ligne As Integer: Dim colonne As Integer
ligne = 11
While (Cells(ligne, 2).Value <> "")
For colonne = 2 To 6
Cells(ligne, colonne).Value = ""
Next colonne
ligne = ligne + 1
Wend
End Sub
Sub parcourirLesFichiers()
'Une procedure qui permet de charger le chemin du dossier contenant les fichiers et mot à rechercher saisi par l'utilisateur
Dim nom_dossier As String: Dim fichier As Object
Dim le_dossier, chaque_fichier: Dim flux_lecture
Dim ligne As Integer: Dim le_fichier As String
Dim contenu As String: Dim chercher As String: Dim remplacer As String
nom_dossier = Range("B5").Value
chercher = Range("B8").Value
ligne = 11
Set fichier = CreateObject("scripting.filesystemobject")
Set le_dossier = fichier.getfolder(nom_dossier)
Set flux_lecture = CreateObject("ADODB.Stream")
For Each chaque_fichier In le_dossier.Files
le_fichier = nom_dossier & "\" & chaque_fichier.Name
contenu = ""
'Ouvrir le fichier charger en mémoire
flux_lecture.Open
flux_lecture.LoadFromFile (le_fichier)
contenu = flux_lecture.ReadText()
flux_lecture.Close
'La copie du mot chercher dans la feuille du formulaireImport à partir de la ligne 11,colonne 2
contenu.Sheets("Feuil1,chercher").Cells.Copyc formulaireImport.Sheets("Import").Range("ligne,2")
flux_lecture.Open
flux_lecture.WriteText contenu
flux_lecture.SaveToFile le_fichier, 2
flux_lecture.Close
Next chaque_fichier
'vider les variables de leurs contenus
Set flux_lecture = Nothing
Set le_dossier = Nothing
Set fichier = Nothing
End Sub