Probleme un macro sur excel
Fermé
kayankaiu
-
27 oct. 2011 à 13:08
michel_m Messages postés 16593 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 23 mars 2023 - 27 oct. 2011 à 17:19
michel_m Messages postés 16593 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 23 mars 2023 - 27 oct. 2011 à 17:19
A voir également:
- Probleme un macro sur excel
- Liste déroulante excel - Guide
- Formule excel - Guide
- Déplacer une colonne excel - Guide
- Convertir chiffre en lettre excel sans macro ✓ - Forum Excel
- Aller à la ligne excel - Guide
1 réponse
michel_m
Messages postés
16593
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mars 2023
3 292
27 oct. 2011 à 15:47
27 oct. 2011 à 15:47
Bonjour,
essaies cette macro
détail: il vaut mieux regrouper les sorties de macro comme les erreurs à la fin du code d'où les "goto" bannis hors des gestions d'erreur
à l'avenir pense à mettre tes codes entre les balises <>(onglet en haut du message)
essaies cette macro
détail: il vaut mieux regrouper les sorties de macro comme les erreurs à la fin du code d'où les "goto" bannis hors des gestions d'erreur
à l'avenir pense à mettre tes codes entre les balises <>(onglet en haut du message)
Sub ModifierLibelle()
'déclaration des variables
Dim ObjShell As Object, strFileName As Object
Dim ObjFolder As Object
Dim OldLibelle As String, NewLibelle As String, NomClasseur As String
Dim Chemin As String, Trouve As String
'empêche le rafraichissement de l'écran pour gagner en rapidité
Application.ScreenUpdating = False
'remplissage des variables :
'NomClasseur = comme son nom l'indique... le nom de ce classeur
'OldLibelle = comme son nom l'indique, l'ancien libellé (à remplacer)
'NewLibelle = comme son nom l'indique... le nouveau libellé
NomClasseur = ThisWorkbook.Name
'on a inscrit l'ancien libellé en D5
OldLibelle = Sheets(1).Range("D5").Value
'on a inscrit le nouveau libellé en D6
NewLibelle = Sheets(1).Range("D6").Value
'test si les libellés (ancien et nouveau) sont bien remplis
If OldLibelle = "" Or NewLibelle = "" Then GoTo saisie
'Ici, partie technique consistant à ouvrir une fenêd'images:"
Set ObjShell = CreateObject("Shell.Application")
Set ObjFolder = ObjShell.BrowseForFolder(&H0&, "choisir un dossier", 1)
'Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, "c:\") ton classeur
If ObjFolder Is Nothing Then GoTo abandon 'Si on sort sans sélection
Chemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ""
ChDir Chemin
'parcours du dossier
fich = Dir("*.xls")
While fich <> ""
If fich <> NomClasseur Then
Workbooks.Open fich
Trouve = ActiveSheet.Cells.Find(OldLibelle, , xlValues).Address
If Trouve <> "" Then
Range(Trouve) = NewLibelle
With ActiveWorkbook
.Save
.Close
End With
End If
End If
fich = Dir
Wend
Exit Sub
'-----------------Gestion des erreurs
saisie:
MsgBox "Saisie obligatoire en D5 et D6", vbCritical
Exit Sub
abandon:
MsgBox "Abandon opérateur", vbCritical, "Annulation"
End Sub
27 oct. 2011 à 16:39
ça exécute mais il ne remplace pas (il me demande le chemin du dossier )
mais il ne remplace pas le remplacement se fait sur la même colonne dans chaque classeur)
merci une 2eme fois pour la réponse
27 oct. 2011 à 16:46
27 oct. 2011 à 17:00
merci encore de votre aide
27 oct. 2011 à 17:04
Tu es sûr que c'est définitif?
27 oct. 2011 à 17:16
je compte bien sur toi
donc au lieu d ouvrir chaque classeur et changerpar 'rechercher replacer' pour chacune de ces 100 claseurs je veux l automatise pour le faire pour les 100 classeurs.
merci