MsgBox被抑制并且图像闪烁开始

Question

使用操作当前电子表格的用户窗体遇到一个奇怪的问题，然后根据用户的选择将文件导出到.pdf或Excel。导出后，它会提示询问是否应重置用户窗体和工作表以重新运行。但是，此时所有MsgBox都被抑制，我在工作表上的一张图像开始闪烁。

我注意到如果我按下ALT而一切似乎都挂了，消息框就会出现，我可以继续。但是只要需要另一个MsgBox，问题就会再次出现。

我已经尝试了Application.ScreenUpdating = False，但这并没有奏效。

以下是我的用户表单上的完成按钮的代码。在此之后我的问题出现了。

Private Sub Finish_Button_Click()
'creates pdf and opens

FileFail = False
QuoteFinish = False

'verify finished
MSG1 = MsgBox("Are you sure you are finished?" & vbCr & vbCr & _
    "  " & Chr(149) & "  " & "Contact Info" & vbCr & _
    "  " & Chr(149) & "  " & "All Items Listed" & vbCr & _
    "  " & Chr(149) & "  " & "Terms & Conditions Populated", vbYesNo, "Verify Finished")
If MSG1 = vbNo Then
    Exit Sub
End If

LastRow = ActiveSheet.UsedRange.Rows.Count
If LastRow = FirstClauseR - 1 Then
    'no Terms & Conditions populated
    MSG1 = MsgBox("You have not added any terms and conditions. Do you want to continue?", vbYesNo)
    TermsExist = False

    If MSG1 = vbNo Then
        Exit Sub
    ElseIf MSG1 = vbYes Then
        Range(LastRow - 1 & ":" & LastRow).EntireRow.Hidden = True
    End If
End If

Application.ScreenUpdating = False

'copy quoter information to below clauses and hide old spot
'if no terms and conditions, do not copy quoter info to below clauses & hide old spot
If TermsExist = True Then
    Range(LastItemR + 2 & ":" & LastItemR + 9).Copy
    Range("A" & LastRow + 3).EntireRow.PasteSpecial xlPasteAll
    Range(LastItemR + 2 & ":" & LastItemR + 9).EntireRow.Hidden = True
End If

On Error GoTo errHandler

Set ws = ActiveSheet
'enter name and select folder for file
'start in current workbook folder

If PDF_Format_Option.Value = True And Excel_Format_Option.Value = False Then
    'PDF format selected
    strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
                & "_" _
                & Format(Now(), "yyyymmdd\_hhmm") _
                & ".pdf"
    strFile = ThisWorkbook.Path & "\" & strFile

    myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strFile, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Select Folder and FileName to save")

    If myFile <> "False" Then
        ws.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

        'open PDF file
        ActiveWorkbook.FollowHyperlink myFile
    Else
        MsgBox "Did not create file"
        FileFail = True
    End If

ElseIf PDF_Format_Option.Value = False And Excel_Format_Option.Value = True Then
    'Excel format selected
    strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
                & "_" _
                & Format(Now(), "yyyymmdd\_hhmm") _
                & ".xlsx"
    strFile = ThisWorkbook.Path & "\" & strFile

    myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strFile, _
            FileFilter:="Excel Files (*.xlsx), *.xlsx", _
            Title:="Select Folder and FileName to save")

    If myFile <> "False" Then
        Quote.Copy
        Range(LastItemR + 2 & ":" & LastItemR + 8).Delete 'remove old signature lines
        ActiveWorkbook.SaveAs myFile, xlOpenXMLWorkbook
        ActiveWorkbook.Close

        'Open Excel file in new instance
        Set xApp = New Excel.Application
        xApp.Workbooks.Open myFile
        xApp.Visible = True
    Else
        MsgBox "Did not create file"
        FileFail = True
    End If

Else
    'exit sub if problem with format selection - this should literally NEVER happen
    MsgBox "Please select one file format before finishing", vbOKOnly
    Exit Sub
End If

'reset location of terms and signature area
If TermsExist = True Then
    Range(LastRow + 3 & ":" & LastRow + 10).Delete
    Range(LastItemR + 2 & ":" & LastItemR + 9).EntireRow.Hidden = False
    'Hide (Unhide) Unused (Used) Quoted For Contact Info Columns
    For r = LastItemR + 3 To LastItemR + 8
        If Range("A" & r) = "" Then
            Range("A" & r).EntireRow.Hidden = True
        Else
            Range("A" & r).EntireRow.Hidden = False
        End If
    Next
End If

'run only if NOT part of failed file creation procedure
If FileFail = False Then
    'return to beginning page and form
    Call Back_Button2_Click
    Call Back_Button1_Click
    'set quote finish boolean, used to supress msg box on reset
    QuoteFinish = True
    'promt for quote reset confirmation
    MSG1 = MsgBox("File created. Do you want to reset quote builder and clear all data?", vbYesNo)
        If MSG1 = vbYes Then
            Call Reset_Button_Click
        End If
End If

'reset QuoteFinish boolean
QuoteFinish = False

Exit Sub

'used for file creation error
errHandler:
    Application.ScreenUpdating = True
    MsgBox "Could not create file"
    'reset location of terms and signature area
    If TermsExist = True Then
        Range(LastRow + 3 & ":" & LastRow + 10).Delete
        Range(LastItemR + 2 & ":" & LastItemR + 9).EntireRow.Hidden = False
        'Hide (Unhide) Unused (Used) Quoted For Contact Info Columns
        For r = LastItemR + 3 To LastItemR + 8
            If Range("A" & r) = "" Then
                Range("A" & r).EntireRow.Hidden = True
            Else
                Range("A" & r).EntireRow.Hidden = False
            End If
        Next
    End If

    On Error GoTo 0
End Sub  

有人遇到类似的问题吗？