Excel宏无限循环不断询问用户输入，无法"step into"调试

Question

我正在创建一些宏来在Excel 2010中执行以下操作：1.创建新工作表时，询问用户要为他/她的工作表命名，并将新工作表设置为提供的名称;按顺序调用Sort_Active_Book和Rebuild_TOC2. Sort_Active_Book：询问用户是否要按升序/降序对工作簿的工作表进行排序，然后继续这样做。3. Rebuild_TOC：删除"目录"页面，并根据工作簿中的所有工作表减去目录本身重新生成它。

我的问题是Excel一直要求我输入要创建的新工作表的名称，并且在代码中没有进一步的进展。我注意到它设法创建了命名工作表，并询问我是否要按升序或降序排序，但随后继续再次询问我新工作表的名称。任何人都可以指出如何解决此问题并提供代码修复（如果可能）吗？

我已经拥有的

此代码部分来自 ThisWorkbook，这是在创建时提示用户输入工作表名称的内容。

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim sName As String
    Dim bValidName As Boolean
    Dim i As Long
    bValidName = False
    Do While bValidName = False
        sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
            If Len(sName) > 0 Then
            For i = 1 To 7
                sName = Replace(sName, Mid(":/?*[]", i, 1), " ")
            Next i
            sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
            If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
        End If
    Loop
    Sh.Name = sName
    Call Sort_Active_Book
    Call Rebuild_TOC
End Sub

这两个宏位于"模块 1"中：

Sub Sort_Active_Book()
    Dim TotalSheets As Integer
    Dim p As Integer
    Dim iAnswer As VbMsgBoxResult
    ' Move the TOC to the begining of the document.
Sheets("TOC").Move Before:=Sheets(1)
    ' Prompt the user as to which direction they wish to
    ' sort the worksheets.
    iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) & "Clicking No will sort in Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
    For TotalSheets = 1 To Sheets.Count
        For p = 2 To Sheets.Count - 1
    ' If the answer is Yes, then sort in ascending order.
            If iAnswer = vbYes Then
                If UCase$(Sheets(p).Name) = "TOC" Then
                   Sheets(p).Move Before:=Sheets(1)
                ElseIf UCase$(Sheets(p).Name) > UCase$(Sheets(p + 1).Name) Then
                   Sheets(p).Move After:=Sheets(p + 1)
            End If
    ' If the answer is No, then sort in descending order.
            ElseIf iAnswer = vbNo Then
            If UCase$(Sheets(p).Name) = "TOC" Then
                Sheets(p).Move Before:=Sheets(1)
            ElseIf UCase$(Sheets(p).Name) < UCase$(Sheets(p + 1).Name) Then
                Sheets(p).Move After:=Sheets(p + 1)
            End If
        End If
    Next p
    Next TotalSheets
End Sub

和

Sub Rebuild_TOC()
    Dim wbBook As Workbook
    Dim wsActive As Worksheet
    Dim wsSheet As Worksheet
    Dim lnRow As Long
    Dim lnPages As Long
    Dim lnCount As Long
    Set wbBook = ActiveWorkbook
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    ' If the TOC sheet already exist delete it and add a new worksheet.
On Error Resume Next
    With wbBook
        .Worksheets(“TOC”).Delete
        .Worksheets.Add Before:=.Worksheets(1)
    End With
    On Error GoTo 0
    Set wsActive = wbBook.ActiveSheet
    With wsActive
        .Name = “TOC”
        With .Range(“A1:B1”)
            .Value = VBA.Array(“Table of Contents”, “Sheet # – # of Pages”)
            .Font.Bold = True
        End With
    End With
    lnRow = 2
    lnCount = 1
    ' Iterate through the worksheets in the workbook and create sheetnames, add hyperlink
    ' and count & write the running number of pages to be printed for each sheet on the TOC.
    For Each wsSheet In wbBook.Worksheets
        If wsSheet.Name <> wsActive.Name Then
            wsSheet.Activate
            With wsActive
                .Hyperlinks.Add .Cells(lnRow, 1), “”, _
                SubAddress:=”‘” & wsSheet.Name & “‘!A1”, _
                TextToDisplay:=wsSheet.Name
                lnPages = wsSheet.PageSetup.Pages().Count
                .Cells(lnRow, 2).Value = “‘” & lnCount & “-” & lnPages
            End With
            lnRow = lnRow + 1
            lnCount = lnCount + 1
        End If
    Next wsSheet
    wsActive.Activate
    wsActive.Columns(“A:B”).EntireColumn.AutoFit
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Answer 1

您正在创建一个带有子Rebuild_TOC的新工作表。导致新工作表宏再次运行。

在

为目录创建新工作表时，您需要通过在代码周围添加启用事件 = false 和 true 来避免运行 newsheet 宏。其余代码似乎正在按预期工作。

Application.EnableEvents = False
With wbBook
    .Worksheets("TOC").Delete
    .Worksheets.Add Before:=.Worksheets(1)
End With
Application.EnableEvents = True

为什么要删除目录工作表，为什么不直接更新它？