• Initiateur de la discussion Initiateur de la discussion Lecardip
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

L

Lecardip

Guest
Bonjour à toutes et à tous,

Pourriez vous m'indiquer une procédure VBA me permettant de modifier des noms (Insertion, Nom, Définir) dans plusieurs classeurs d'un même repertoire. Exemple : Base_de_données par Database, Extraction par Extract et Critères par Criteria. Pour couronner le tout j'ai dans certains classeurs aucun nom à modifier. J'ai déjà commencer à faire une boucle pour ouvrir les différents classeurs de mon repertoire.

Merci par avance.

Pascal




Ci-joint le début de ma procédure :

Sub ModiNomsDansFeui()
'
' Macro enregistrée le 26/01/2004 par PL

'Cette procédure permet le transfert sous XP de Saref, en remplaçant modifiant les noms de
'Base_de_données par Database; Critères par Criteria; Extraction par Extract.


Dim FichAOuvr, NomFich, NumeFich, Chemin, MonObjet

Chemin = "c:\Saref\donepro\"

ChDir Chemin

NomFich = Dir("*.xls")
NumeFich = 1

While NomFich <> ""

FichAOuvr = Chemin + NomFich
Workbooks.Open Filename:=FichAOuvr, UpdateLinks:=0, WriteResPassword:="carene"
If "Database" = 0 Then
Application.Goto Reference:="Database"

ActiveWorkbook.Close SaveChanges:=False

ActiveWorkbook.Names.Add Name:="Database", RefersToR1C1:="=BDDP12A!R83C1:R3143C5"
ActiveWorkbook.Names("Database").Delete
Range("A1").Select
End If
'Application.DisplayAlerts = False
'ActiveWorkbook.SaveAs Filename:=FichAOuvr, FileFormat:=xlNormal, WriteResPassword:="carene", ReadOnlyRecommended:=False, CreateBackup:=False
'Application.DisplayAlerts = True
'ActiveWorkbook.Close SaveChanges:=False
'NomFich = Dir
'NumeFich = NumeFich + 1
Wend

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour