保存外部工作簿后删除名称管理器中的所有输入

Posted 2023-05-07

【中文标题】保存外部工作簿后删除名称管理器中的所有输入

【英文标题】：Deleting all input in the Name Manager after saving external workbook

【发布时间】：2021-06-29 09:32:53

【问题描述】：

我目前正在制作一个宏，它创建一个目录，然后以不同的语言将其保存为外部文件。每当我使用下面的 VBA 脚本保存文件时，文件仍然很大（2MB+），但每当我打开文件并删除名称管理器中的所有引用（这些似乎也被复制）时，文件只有 30/40 KB。

是否有 VBA 公式可以自动删除名称管理器中的公式（仅在外部副本中，不在原始文件中！）？

Sub NIP_Version()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks("Opbouw catalogus.xlsm").Activate

filenaam = ActiveWorkbook.Path & "\" & "Excel prijslijst" & "\" & Sheets("Catalogus").Range("A1").Text & " " & Sheets("Catalogus").Range("G2").Text

'Quotation blad copy
Sheets("Catalogus").Select

'paste as values

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Dim LastRowNIP As Long
With ActiveSheet
LastRowNIP = .Cells(.Rows.Count, "E").End(xlUp).Row
End With

Set example = Range("A5:G" & LastRowNIP)

example.Value = example.FormulaR1C1

Columns("F").EntireColumn.AutoFit

'Save
Application.ScreenUpdating = True
Sheets("Catalogus").Range("A1").Select
ActiveSheet.Copy
ActiveWorkbook.Sheets("Catalogus").SaveAs Filename:=filenaam, FileFormat:=51

Application.DisplayAlerts = True

ActiveWorkbook.Close SaveChanges:=False

【参考方案1】：

    Sub remove_names()

        Dim xName As Name

            For Each xName In Application.ThisWorkbook.Names

                xName.Delete

            Next xName

     End Sub

【讨论】：

您好乔，感谢您的帮助。但这似乎还行不通。我收到错误消息“1004”，我输入的名称无效。我刚刚检查了它，但还不能真正解决它。 Dim 的命名是否正确？在此先感谢:)

嗨 Rob，我已经对此进行了测试，它对我有用。它会为我删除存储在您的名称管理器中的所有本地名称。您可以发送您的名称管理器的屏幕截图以及它中断的“调试错误”行吗？

"xName" 在我的代码 sn-p 中可以称为你喜欢的任何东西，只要它在以下几行中正确引用

感谢您的帮助。我收到的错误是：运行时错误“1004”您输入的名称无效。原因可能包括： - 名称不以字母或下划线开头。 - 名称包含空格或其他无效字符。 - 名称与 Excel 内置名称或工作簿中另一个对象的名称冲突。

我贴出来了。已经感谢您的帮助:)

【参考方案2】：

Sub NIP_Version()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks("Opbouw catalogus.xlsm").Activate

filenaam = ActiveWorkbook.Path & "\" & "Excel prijslijst" & "\" & Sheets("Catalogus").Range("A1").Text & " " & Sheets("Catalogus").Range("G2").Text

'Quotation blad Copy
Sheets("Catalogus").Select

'Paste as value

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Dim LastRowNIP As Long
With ActiveSheet
LastRowNIP = .Cells(.Rows.Count, "E").End(xlUp).Row
End With

Set example = Range("A5:G" & LastRowNIP)

example.Value = example.FormulaR1C1

Columns("F").EntireColumn.AutoFit

'Save
Application.ScreenUpdating = True
Sheets("Catalogus").Range("A1").Select
ActiveSheet.Copy
ActiveWorkbook.Sheets("Catalogus").SaveAs Filename:=filenaam, FileFormat:=51

Sub remove_names()

Dim xName As Name

    For Each xName In Application.ThisWorkbook.Names

            xName.Delete

    Next xName

End Sub

Application.DisplayAlerts = True

ActiveWorkbook.Close SaveChanges:=False

Workbooks("Prijslijst maken.xlsm").Activate