Macro Visual Basic (VBA), rechercheV et correction
Ferméeriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 - 7 oct. 2022 à 19:40
- Macro Visual Basic (VBA), rechercheV et correction
- Visual basic download - Télécharger - Langages
- Microsoft 365 basic - Guide
- Microsoft visual c++ runtime - Guide
- Macro word - Guide
- Macro logiciel - Télécharger - Organisation
5 réponses
Modifié le 16 sept. 2022 à 19:00
Bonjour,
je ne fais que la partie remplacement car on ne peut boucler sur les fichiers de ton cloud
Sub test()
Dim r As String, f As String, wb As Workbook
Dim c As Range, erreur(1 To 1000, 1 To 1), nbErr As Long
Set wb = Workbooks("dhj.xls.xlsx") 'remplacer par l'ouverture d'un fichier
With wb.Worksheets("Dossier")
Set c = .Cells.Find("Documents clients", , xlValues, xlWhole)
If Not c Is Nothing Then
c.Offset(, 1) = "N/A"
Else
nbErr = nbErr + 1
erreur(nbErr, 1) = wb.Name
End If
End With
' If nbErr > 0 Then [C2].Resize(1000) = erreur ' ecriture erreurs, choisir feuille et colonne
' ActiveWorkbook.Save
' wb.Close False
End Sub
et tu devrais remplacer f = Dir(r & "*.xlsx") par f = Dir(r & "*.xls*")
eric
16 sept. 2022 à 23:50
Il faut l'intégrer à ton code qui ouvre les fichiers du répertoire.
Tu vois que le nom du fichier que j'ai utilisé pour les tests est écrit en dur
17 sept. 2022 à 08:44
Ca y est ça fonctionne. Je l'avais intégré mais pas dans les règles de l'art. Un grand merci à toi Eric.
Pour ceux qui souhaite s'inspirer de cette macro la voici...
Option Explicit
Sub test()
Dim r As String, f As String, wb As Workbook
Dim c As Range, erreur(1 To 1000, 1 To 1), nbErr As Long
r = ThisWorkbook.Path & "\ici\"
f = Dir(r & "*.xls") 'Remplacer par l'extension ".xls" par ".xlsx" si nécessaire
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(r & f)
With wb.Worksheets("Dossier")
Set c = .Cells.Find("Documents clients", , xlValues, xlWhole)
If Not c Is Nothing Then
c.Offset(, 1) = "N/A"
Else
nbErr = nbErr + 1
erreur(nbErr, 1) = wb.Name
End If
End With
ActiveWorkbook.Save
wb.Close False
End If
f = Dir
Loop
End Sub
Modifié le 17 sept. 2022 à 08:48
Je souhaiterai faire maintenant la même chose avec un logo positionné sur toutes les feuilles des 1000 fichiers Excel. Je souhaiterai changer ce logo (image) par un nouveau (image).
Est-ce possible ?
17 sept. 2022 à 09:54
Bonjour,
je t'avais d'essayer avec :
Dir(r & "*.xls*")
avec une * pour traiter *.xls et *.xlsm
Pour ta nouvelle question tu dois démarrer un nouveau topic avec plus de détails.
Et déposer un fichier de travail sur cjoint.com et coller le lien fourni dans ton post.
eric
4 oct. 2022 à 12:30
Bonjour Eric, bon ma macro fonctionne parfaitement et je te remercie de ton aide. Cependant, je souhaiterai l'améliorer car bien évidemment, je viens de m'apercevoir de quelque problème à son exécution :
1/ la feuille Excel que j'appelle dans cette macro n'a pas toujours le même nom. Parfois, elle s'appelle "Dossier", parfois "Dossier " (avec un espace après le r) et parfois même " Dossier" (avec un espace avant le D). Du coup, j'ai un message d'erreur lorsque j'exécute la macro. Comment faire en sorte qu'elle fonctionne qu'elle que soit la syntaxe de la feuille ?
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(r & f)
With wb.Worksheets("Dossier")
Set c = .Cells.Find("Documents clients", , xlValues, xlWhole)
2/ Je souhaiterai que la macro s'exécute dans des fichier contenus dans des sous-dossier au dossier "ici".
Sub test()
Dim r As String, f As String, wb As Workbook
Dim c As Range, erreur(1 To 1000, 1 To 1), nbErr As Long
r = ThisWorkbook.Path & "\ici\"
f = Dir(r & "*.xls") 'Remplacer par l'extension ".xls" par ".xlsx" si nécessaire
Le plus important serait de résoudre le 1/ car pour le 2/ j'ai une solution (un peu chiante) qui consiste à extraire chaque fichier de son dossier en les plaçant la racine.
cdlt,
Jérôme
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
4 oct. 2022 à 19:45
Bonjour,
ce qu'il faut c'est agir à la source et ne pas accepter de telles erreurs.
Si tu refuses leur fichier en leur demandant de refaire correctement ils apprendront vite.
Renommer les feuilles le temps qu'ils comprennent :
Dim sh As Worksheet
For Each sh In wb.Worksheets
sh.Name = Trim(sh.Name) ' supprime les espaces début et fin de chaine
' sh.Name = Application.Trim(sh.Name) ' supprime aussi les espaces multiples entre mots pour n'en laisser q'un
Next sh
à toi de voir si tu sauvegarde le fichier corrigé...
Pour le 2) tu trouveras sans difficulté sur google des exemples de balayage des sous-dossiers
eric
7 oct. 2022 à 19:40
de rien...
16 sept. 2022 à 19:59
Bonjour Eric,
Merci beaucoup mais... ça ne fonctionne pas. Je pense que ça vient de moi. Je ne maîtrise rien à VBA.