2,462
社区成员
发帖
与我相关
我的任务
分享
Sub ClearNames()
' 用于清除当前工作簿中的名称定义
' 2008-04-23 Tiger_Zhao
Dim reservedNames() '保留的名称定义(打印区域、打印标题)
reservedNames = Array("*!Print_Area", "*!Print_Titles")
Dim allNames As Names
Set allNames = ActiveWorkbook.Names
Dim lCountBefore As Long
lCountBefore = allNames.Count
Dim i As Long, j As Long
i = 1
While i <= allNames.Count
For j = 0 To UBound(reservedNames)
If Names(i).Name Like reservedNames(j) Then
Debug.Print "Reserved:", Names(i).Name & Names(i).Value
i = i + 1
GoTo NextName
End If
Next
Names(i).Delete
NextName:
Wend
MsgBox "完成名称定义的清除:" & vbCrLf & _
"清除前 " & lCountBefore & " 个," & vbCrLf & _
"清除后 " & allNames.Count & " 个。", _
vbInformation
End Sub