Problème d'effacement de noms

[Calvus]

Bonsoir le forum,

A la suite d'une copie dans un nouveau classeur, je tente d'effacer les formules nommées, mais sans succès. Plantage assuré.
C'est en copiant dans un classeur créé par la macro.

Le même code (copié collé) fonctionne dans d'autres cas.

Voici le code qui génère une erreur :

Dim LePath As String, LePath2 As String, LeNom As String, fichier As String, Dossier As String, Chemin As String
    On Error GoTo fin
  '"C:\Users\XXXXX\Documents\0 Travail\Autre\XXXXXXX\Copie des Factures\Factures"
    'Enregistrement de la feuille
    LePath = "C:\Users\XXXXXXXX\Documents\0 Travail\Autre\XXXXXXXXXX\Clients\Factures\"
    LePath2 = "C:\Users\XXXXXXXXXX\Documents\0 Travail\Autre\XXXXXXXXX\Copie des Factures\Factures\"
    ActiveSheet.Copy
    ActiveSheet.Range("L1:R140,AA1:AK100").Clear
    ActiveSheet.Shapes.Range(Array("CommandButton1", "CommandButton2", _
                                       "ToggleButton1", "ToggleButton2", "CommandButton3", "CommandButton4", "CommandButton5")).Delete
  

For Each c In ActiveSheet.[A1:AK132].SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next

Dim n As Name
    For Each n In ActiveWorkbook.Names
           n.Delete
    Next n

Ça plante su la dernière partie, For each n...


Voici le code qui fonctionne en ouvrant un classeur existant :

  Cells.Copy
    On Error Resume Next
    Workbooks("Historique Factures XXXXXXX 2016.xlsx").Activate
    If Err.Number <> 0 Then
    Workbooks.Open ("C:\Users\XXXXXXXXXXX\Documents\0 Travail\Autre\XXXXXXXX\Clients\Archives\Historique Factures XXXXXXXXXXX 2016.xlsx")
    End If
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = nouvonglet
    ActiveSheet.Paste
    ActiveWindow.Zoom = 80
    ActiveWindow.Columns("L:AS").Delete
    For Each c In ActiveSheet.[A1:AK132].SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next
    For Each n In ActiveWorkbook.Names
           n.Delete
    Next n

Dites moi s'il est nécessaire de joindre un classeur, sachant que mon classeur est vraiment très gros et qu'il y a une quarantaine de formules nommées.
Ça va pas être de la tarte de tout refaire, et surtout je ne sais pas si ce sera représentatif du vrai classeur. Mais je le ferai si besoin.

Merci de votre aide.

 

[Dranreb]

Re : Problème d'effacement de noms

Bonsoir.
Dans certains classeurs j'ai parfois trouvés dans la collection Names des choses qui n'apparaissent pas dans le gestionnaire des noms, dont la propriété Name commence par "_xlfn." et qu'on ne peux pas supprimer.
J'ai donc renoncé à le faire. Mettez On Error Resume Next pour que ça ne plante plus la macro ni n'empêche de supprimer les autres.

 

[Calvus]

Re : Problème d'effacement de noms

Bonsoir Dranreb,

J'avais essayé mais j'obtenais une erreur quand même.....dû à une autre partie du code en fait.

A la lecture de votre réponse, j'ai modifié me disant que vous m'aviez mis sur la bonne piste.

Voici donc le code modifié :

Dim LePath As String, LePath2 As String, LeNom As String, fichier As String, Dossier As String, Chemin As String
    On Error GoTo fin
    'Enregistrement de la feuille
    LePath = "C:\Users\XXXXXXX\Documents\0 Travail\Autre\XXXXXXXX\Clients\Factures\"
    LePath2 = "C:\Users\XXXXXXX\Documents\0 Travail\Autre\XXXXXXX\Copie des Factures\Factures\"
    ActiveSheet.Copy
    ActiveSheet.Shapes.Range(Array("CommandButton1", "CommandButton2", _
                                       "ToggleButton1", "ToggleButton2", "CommandButton3", "CommandButton4", "CommandButton5", "CommandButton6")).Delete
  
On Error Resume Next

For Each c In ActiveSheet.[A1:j132].SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next

ActiveSheet.Columns("L:AS").Delete
    
Dim n As Name
    For Each n In ActiveWorkbook.Names
           n.Delete
    Next n

Merci beaucoup, vous m'enlevez une belle épine du pied.

Bonne nuit.