Delete Custom Formats

Excel 宏代码优化

Jim Rech 在十多年前发布的以下代码，在 2007 版之前的 Excel 中一直为我所用。是否有任何建议，说明如何修改此代码以适应 Excel 2007？

Sub Delete_formats()
    Dim i As Integer
    SendKeys "%c{PgDn}%t{tab}{end}"
    For i = 1 To 100
        SendKeys "%d{end}"
    Next
    Application.Dialogs(xlDialogFormatNumber).Show
End Sub

以下宏在 Excel 2007 中仍然对我有效。它会删除当前工作簿中所有未使用的自定义数字格式，即工作表中任何单元格未使用的格式。该宏不检查图表中使用的数字格式，因此仅在图表中使用的自定义格式将被移除。可以通过修改宏（只需注释掉检查格式是否使用的部分）轻松使其删除所有自定义格式。

Sub RemoveUnusedNumberFormats()
    Dim strOldFormat As String
    Dim strNewFormat As String
    Dim aCell As Range
    Dim sht As Worksheet
    Dim strFormats() As String
    Dim fFormatsUsed() As Boolean
    Dim i As Integer
    If ActiveWorkbook.Worksheets.Count = 0 Then
        MsgBox "The active workbook doesn't contain any worksheets.", vbInformation
        Exit Sub
    End If
    On Error GoTo Exit_Sub
    Application.Cursor = xlWait
    ReDim strFormats(1000)
    ReDim fFormatsUsed(1000)
    Set aCell = Range("A1")
    aCell.Select
    strOldFormat = aCell.NumberFormatLocal
    aCell.NumberFormat = "General"
    strFormats(0) = "General"
    strNewFormat = aCell.NumberFormatLocal
    i = 1
    Do
        SendKeys "{TAB 3}{DOWN}{ENTER}"
        Application.Dialogs(xlDialogFormatNumber).Show strNewFormat
        strFormats(i) = aCell.NumberFormat
        strNewFormat = aCell.NumberFormatLocal
        i = i + 1
    Loop Until strFormats(i - 1) = strFormats(i - 2)
    aCell.NumberFormatLocal = strOldFormat
    ReDim Preserve strFormats(i - 2)
    ReDim Preserve fFormatsUsed(i - 2)
    For Each sht In ActiveWorkbook.Worksheets
        For Each aCell In sht.UsedRange
            For i = 0 To UBound(strFormats)
                If aCell.NumberFormat = strFormats(i) Then
                    fFormatsUsed(i) = True
                    Exit For
                End If
            Next i
        Next aCell
    Next sht
    On Error Resume Next
    For i = 0 To UBound(strFormats)
        If Not fFormatsUsed(i) Then
            ActiveWorkbook.DeleteNumberFormat strFormats(i)
        End If
    Next i
Exit_Sub:
    Set aCell = Nothing
    Set sht = Nothing
    Erase strFormats
    Erase fFormatsUsed
    Application.Cursor = xlDefault
End Sub