Mise à jour cellules nommées dans macros suite à conversion de xls en xlsm

Bonjour à toutes et tous,

Comme indiqué dans le titre, j'ai converti un ancien fichier xls (contenant des macros) en xlsm. J'ai environ 70 cellules (ou plages) nommées du style "chf1", "chf2", "chf3", "LL1", etc… qui ont été renommées en "_chf1", "_chf2", "_chf3", "_LL1". Jusque-là, tout est tout à fait normal.

Le problème est que ces noms n'ont pas été modifiés dans les macros.

Il faut maintenant que je le fasse à la main et il y en a beaucoup.

De plus, mon fichier appelle des macros situées dans des classeurs externes.

Y-aurait-il moyen de créer une boucle qui parcourt toutes les plages nommées concernées de tous les classeurs ? Je ne vois pas trop comment m'y prendre et j'aimerai éviter de le faire une par une dans chaque classeur.

Auriez-vous une idée à me proposer pour accélérer le traitement et surtout éviter de générer des erreurs en effectuant de faux remplacements ou en oublier ?

D'avance merci pour votre aide.

Boris

Bonjour,

Il serait peut-être plus simple de rebaptiser les zones avec leur nom d'origine, non ?

Bonjour,

Avec Ctrl + H cela n'est pas possible ? ou bien c'est trop long ?

Eric, merci pour ta réponse mais il n'est pas possible de rebaptiser les zones avec leur nom d'origine car les zones rebaptisées correspondent à des références de cellules. Dans la version Excel 2003, la référence de la dernière colonne est "IV", dans les dernières versions d'Excel c'est "XFD". C'est d'ailleurs pour cette raison que les zones ont été renommées lors de la conversion.

Valentin85, merci également pour ta réponse. Mais ta solution nécessite de le faire "à la main" et c'est bien ce que je souhaiterais éviter.

Comment se présente une procédure à modifier ? Avec ancien et nouveau nom.

Pour faire l'inventaire des zones nommées :

Sub ListerLesZonesNommees()

Dim LigneTitreZone As Long, DerniereLigneZNommee As Long
Dim Wb As Workbook
Dim ShListesZones As Worksheet
Dim MaZoneNommee As Name

    Set ShListesZones = ThisWorkbook.Sheets.Add

    Set Wb = Workbooks("XXXXX.xlsm") ' A adapter

    With ShListesZones
         .Cells.Clear
         LigneTitreZone = 10
         DerniereLigneZNommee = LigneTitreZone + 1
         With .Range(.Cells(LigneTitreZone, 1), .Cells(LigneTitreZone, 2))
            .Value = Array("Nom", "Adresse")
            .Interior.Color = RGB(255, 255, 0)
            .Font.Bold = True
         End With

         For Each MaZoneNommee In Wb.Names
             .Cells(DerniereLigneZNommee, 1).Value = MaZoneNommee.Name
             .Cells(DerniereLigneZNommee, 2).Value = "'" & MaZoneNommee.RefersTo
             DerniereLigneZNommee = DerniereLigneZNommee + 1
         Next MaZoneNommee

    End With

    Set ShListesZones = Nothing
    Set Wb = Nothing

End Sub

En fait, je n'ai pas besoin de lister les zones nommées. Je les ai déjà ainsi que les références dont voici un extrait :

image

Ce que je souhaite, c'est parcourir (de façon automatisée par une procédure VBA) les noms de ces zones dans le code VBA de toutes les macros et remplacer les anciens noms par les nouveaux générés par Excel et ce de façon automatisée par une procédure VBA.

Voici une des nombreuses procédures à corriger avec les zones chf1, chf2,..., vmc1, vmc2,....

Sub ReportBa()
  Dim lgn As Integer
  Dim cln As Integer
  Dim um As Integer

Sheets("Donnee").Select

 'Report de la donnée "niveau"
    Range("Nivo").Formula = nivt

 'Report des données "mode Rdc"
    If UFbati.TBsol1.Value = True Then
        If mnrj = 2 And mpac1 = 1 Then
            Range("chf1").Formula = 16
        ElseIf mnrj = 2 And mpac1 = 2 Then
            Range("chf1").Formula = 19
        ElseIf mnrj = 2 And mpac1 = 3 Then
            Range("chf1").Formula = 19
        ElseIf mrj > 2 And mpac1 = 4 Then
            Range("chf1").Formula = 19
        ElseIf mrj > 2 And mpac1 = 5 Then
            Range("chf1").Formula = 16
        ElseIf mrj > 2 And mpac1 = 6 Then
            Range("chf1").Formula = 19
        End If
        Range("mchf1").Formula = 2
    Else
        If mnrj = 2 And mpac1 = 1 Then
            Range("chf1").Formula = 4
        ElseIf mnrj = 2 And mpac1 = 2 Then
            Range("chf1").Formula = 10
        ElseIf mnrj = 2 And mpac1 = 3 Then
            Range("chf1").Formula = 12
        ElseIf mrj > 2 And mpac1 = 4 Then
            Range("chf1").Formula = 12
        ElseIf mrj > 2 And mpac1 = 5 Then
            Range("chf1").Formula = 26
        ElseIf mrj > 2 And mpac1 = 6 Then
            Range("chf1").Formula = 10
        End If
        Range("mchf1").Formula = 1
    End If

 'Report des données "mode 1/2 niveau "
    If nivt = 1 Or nivt = 3 Then

    Else
        If UFbati.TBsol2.Value = True Then
            If mnrj = 2 And mpac1 = 1 Then
                Range("chf2").Formula = 16
            ElseIf mnrj = 2 And mpac1 = 2 Then
                Range("chf2").Formula = 19
            ElseIf mnrj = 2 And mpac1 = 3 Then
                Range("chf2").Formula = 19
            ElseIf mrj > 2 And mpac1 = 4 Then
                Range("chf2").Formula = 19
            ElseIf mrj > 2 And mpac1 = 5 Then
                Range("chf2").Formula = 16
            ElseIf mrj > 2 And mpac1 = 6 Then
                Range("chf2").Formula = 19
            End If
            Range("mchf2").Formula = 2
        Else
            If mnrj = 2 And mpac1 = 1 Then
                Range("chf2").Formula = 4
            ElseIf mnrj = 2 And mpac1 = 2 Then
                Range("chf2").Formula = 10
            ElseIf mnrj = 2 And mpac1 = 3 Then
                Range("chf2").Formula = 12
            ElseIf mrj > 2 And mpac1 = 4 Then
                Range("chf2").Formula = 12
            ElseIf mrj > 2 And mpac1 = 5 Then
                Range("chf2").Formula = 26
            ElseIf mrj > 2 And mpac1 = 6 Then
                Range("chf2").Formula = 10
            End If
            Range("mchf2").Formula = 1
        End If
    End If
    'Report des données "mode niveau 1"
    If nivt < 3 Then
        '
    Else
        If UFbati.TBsol3.Value = True Then
            If mnrj = 2 And mpac1 = 1 Then
                Range("chf3").Formula = 16
            ElseIf mnrj = 2 And mpac1 = 2 Then
                Range("chf3").Formula = 19
            ElseIf mnrj = 2 And mpac1 = 3 Then
                Range("chf3").Formula = 19
            ElseIf mrj > 2 And mpac1 = 4 Then
                Range("chf3").Formula = 19
            ElseIf mrj > 2 And mpac1 = 5 Then
                Range("chf3").Formula = 16
            ElseIf mrj > 2 And mpac1 = 6 Then
                Range("chf3").Formula = 19
            End If
            Range("mchf3").Formula = 2
        Else
            If mnrj = 2 And mpac1 = 1 Then
                Range("chf3").Formula = 2
            ElseIf mnrj = 2 And mpac1 = 2 Then
                Range("chf3").Formula = 10
            ElseIf mnrj = 2 And mpac1 = 3 Then
                Range("chf3").Formula = 12
            ElseIf mrj > 2 And mpac1 = 4 Then
                Range("chf3").Formula = 12
            ElseIf mrj > 2 And mpac1 = 5 Then
                Range("chf3").Formula = 26
            ElseIf mrj > 2 And mpac1 = 6 Then
                Range("chf3").Formula = 10
            End If
            Range("mchf3").Formula = 1
        End If
    End If

    'Report de la donnée type pl
    If UFbati.BRplanchcb1.Value = True Then
        Range("planchcb").Formula = 1
    ElseIf UFbati.BRplanchcb2.Value = True Then
        Range("planchcb").Formula = 2
    Else
        Range("planchcb").Formula = 3
    End If
    'Report de la donnée terrasse
    If UFbati.CBterrasse.Value = True Then
        Range("prestras").Formula = 1
    Else
        Range("prestras").Formula = 0
    End If

    'Report des données de vmc
    If dpbati = 1 Then
        Range("vmc1").Formula = bvmc1
        Range("vmc2").Formula = bvmc2
        Range("vmc3").Formula = bvmc3
        Range("vmc4").Formula = bvmc4
        Range("vmc5").Formula = bvmc5
        Range("vmc6").Formula = bvmc6
        Range("vmc7").Formula = 0
        Range("type").Formula = btype
    End If

    'Mise en forme des données surfaces
    lgn = Range("AHR").Row
    cln = Range("AHR").Column
    If nivt = 1 Then
        Cells(lgn + 1, cln).Interior.ColorIndex = 3
        Cells(lgn + 1, cln).Formula = 0
        Cells(lgn + 2, cln).Interior.ColorIndex = 3
        Cells(lgn + 2, cln).Formula = 0
        Cells(lgn + 4, cln).Interior.ColorIndex = 3
        Cells(lgn + 5, cln).Interior.ColorIndex = 3
        Cells(lgn + 8, cln).Interior.ColorIndex = 3
        Cells(lgn + 9, cln).Interior.ColorIndex = 3
        Cells(lgn + 10, cln).Interior.ColorIndex = 3
        Cells(lgn + 11, cln).Interior.ColorIndex = 3
        Cells(lgn + 12, cln).Interior.ColorIndex = 3
        Cells(lgn + 13, cln).Interior.ColorIndex = 3
        Cells(lgn + 14, cln).Interior.ColorIndex = 3
    ElseIf nivt = 2 Then
        Cells(lgn + 2, cln).Interior.ColorIndex = 3
        Cells(lgn + 2, cln).Formula = 0
        Cells(lgn + 5, cln).Interior.ColorIndex = 3
        Cells(lgn + 9, cln).Interior.ColorIndex = 3
    ElseIf nivt = 3 Then
        Cells(lgn + 1, cln).Interior.ColorIndex = 3
        Cells(lgn + 1, cln).Formula = 0
        Cells(lgn + 4, cln).Interior.ColorIndex = 3
        Cells(lgn + 8, cln).Interior.ColorIndex = 3
    End If

End Sub

J'espère avoir été un peu plus clair.

Le code ci-dessous recense les zones nommées dans un module et les note dans un onglet "Zones nommées"

Sub TestDetecterZoneNommeeModule()

    DetecterZoneNommeeModule Sheets("Zones nommées"), "Module1"

End Sub

Sub DetecterZoneNommeeModule(ByVal Sh As Worksheet, NomModule As String)

Dim x As Integer, LigneEnCours As Integer
Dim Texte As String, strVar As String

    LigneEnCours = 2
   With ThisWorkbook.VBProject.VBComponents(NomModule).CodeModule
          For x = 1 To .CountOfLines
             Texte = .Lines(x, 1)
             If InStr(1, Texte, "Range", vbTextCompare) > 0 Then
                Sh.Cells(LigneEnCours, 1) = Texte
                LigneEnCours = LigneEnCours + 1
             End If
          Next x
    End With

End Sub

Vous allez récupérer les données comme ceci :

capture

Une fois les zones mises dans un tableau structuré t_Zones

capture

Le code ci-dessous met à jour les lignes de code :

Option Explicit
Option Compare Text

Sub TestRemplacerZoneNommeeModule()

Dim AireZones As Range

     Set AireZones = Range("t_Zones[Ancien]")
     RemplacerZoneNommeeModule "Module1", AireZones
     Set AireZones = Nothing

End Sub

Sub RemplacerZoneNommeeModule(ByVal NomModule As String, ByVal AireZones2 As Range)

Dim x As Integer, Y As Integer
Dim Texte As String, strVar As String, ZoneAvant As String, ZoneApres As String

   With ThisWorkbook.VBProject.VBComponents(NomModule).CodeModule
          For x = 1 To .CountOfLines
             Texte = .Lines(x, 1)
             For Y = 1 To AireZones2.Count
                  ZoneAvant = "Range(""" & AireZones2(Y).Value & """)"
                  ZoneApres = "Range(""" & AireZones2(Y).Offset(0, 1).Value & """)"

                 If InStr(1, Texte, ZoneAvant, vbTextCompare) > 0 Then
                    strVar = Application.WorksheetFunction.Substitute(Texte, ZoneAvant, ZoneApres)
                    .ReplaceLine x, strVar
                    Exit For
                 End If
             Next Y
          Next x
    End With

End Sub

Il vous faut ensuite adapter ce code pour balayer tous les modules.

Merci Eric

C'est excellent. Cela va me faire gagner un temps fou.

Je ne connaissais pas cette façon d'intervenir dans le code des procédures.

Maintenant, il me reste à intégrer une boucle pour parcourir toutes les procédures de tous les classeurs concernés.

Encore un grand merci.

Rechercher des sujets similaires à "mise jour nommees macros suite conversion xls xlsm"