1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
| Sub RemplacerEtSupprimerNomsOEKN()
Dim i, j As Integer
Dim Cible, PathName, FileName, FileToWorkWith, FeuilleOuNomCellule As String
Dim Classeur As Workbook
Dim Feuille As Worksheet
' S'assurer que le nom à traiter est bien dans le workbook
' Voir pour les noms de cellules spécifiques à une feuille ???
' Chemin d'accès et Nom du fichier à traiter
PathName = "C:\Data\"
FileName = "DataTest.xls"
FileToWorkWith = PathName & FileName
' S'assurer que le workbook à traiter est ouvert
' S'assurer que c'est lui qui est le workbook actif
MsgBox IsFileOpen(FileToWorkWith)
If IsFileOpen(FileToWorkWith) _
Then
' Afficher un message indiquant que le fichier est ouvert et actif.
MsgBox FileName & " : " & "déjà ouvert et actif !"
Else
' Afficher un message indiquant que le fichier n'était pas ouvert
' qu'il va être ouvert et activé
MsgBox FileName & " : " & "va être ouvert !"
Workbooks.Open FileToWorkWith
End If
' Comme le fichier est ouvert et en mémoire, plus besoin du pathway, donc
' on désigne le fichier sur lequel on va travailler, uniquement par son nom
' sans intégrer le pathway !!!
Workbooks(FileName).Activate
Set Classeur = ActiveWorkbook
For i = 1 To UBound(TableauDesNoms)
' On met en correspondance l'ancien et le nouveau nom qui est destiné à le remplacer
MsgBox TableauDesNoms(i)
' Vérifier si le nom comprend le nom d'une feuille du classeur
' en vérifiant la présence du caractère "!" dans la chaine de caractère
' du nom traité
If InStr(1, TableauDesNoms(i), "!") > 0 Then
FeuilleOuNomCellule = Left(TableauDesNoms(i), InStr(1, TableauDesNoms(i), "!") - 1)
MsgBox FeuilleOuNomCellule
Workbooks(FileName).Worksheets(FeuilleOuNomCellule).Activate
Cible = Classeur.Names(TableauDesNoms(i)).RefersTo
Else
Cible = Classeur.Names(TableauDesNoms(i)).RefersTo
End If
If TableauDesNouveauxNoms(i) <> "X" Then
' Pour chacune des feuilles du workbook actif, remplace l'ancien nom par le nouveau
For j = 2 To Sheets.Count
Sheets(j).Cells.Replace What:=TableauDesNoms(i), Replacement:=TableauDesNouveauxNoms(i), LookAt:=xlPart
Next j
' Supprime ensuite l'ancien nom
Classeur.Names(TableauDesNoms(i)).Delete
' et renomme la plage initiale en lui affectant la même adresse
Classeur.Names.Add Name:=TableauDesNouveauxNoms(i), RefersTo:=Cible
Else
' Supprime le nom inutilisé du workbook
Classeur.Names(TableauDesNoms(i)).Delete
End If
Next i
End Sub |
Partager