excel 使用MsgBox并在我选择“取消”时收到错误消息1004-需要宏正常结束

rta7y2nd  于 2022-12-20  发布在  其他
关注(0)|答案(6)|浏览(167)

首先,我对问题“是否更改工作表名称?"选择了“是”。然后出现消息“键入新的工作表名称”。我没有键入新名称并选择“确定”,而是选择了“取消”按钮,显示了错误消息。如何避免看到错误消息并让宏“安静地”结束?

Option Explicit ' Force explicit variable declaration.

Sub ChangeSheetName()

Dim Carryon As String

On Error GoTo eh

Carryon = MsgBox("Change Worksheet Name?", vbYesNo)

If Carryon = vbYes Then

    Dim shName As String
    Dim currentName As String
    currentName = ActiveSheet.Name
    shName = InputBox("Type new Worksheet name")
    ThisWorkbook.Sheets(currentName).Name = shName
End If
Exit Sub

eh:
    MsgBox "The following error occured." _
        & vbCrLf & "" _
        & vbCrLf & "Error Number is: " & Err.Number _
        & vbCrLf & "" _
        & vbCrLf & "Error Description is: " & Err.Description _
        & vbCrLf & "" _
        & vbCrLf & "You likely hit the Esc key to stop renaming the Worksheet." _
        & vbCrLf & "" _
        & vbCrLf & "No worries.  You can try again to rename or leave it as is." _
        & vbCrLf & "" _
        & vbCrLf & "No harm done."

End Sub
t5fffqht

t5fffqht1#

谢谢大家的回答。
最后我只是删除了错误处理代码并添加了一个额外的If语句。

Sub ChangeSheetName()
    
    Dim Carryon As String
    
    Carryon = MsgBox("Change Worksheet Name?", vbYesNo)
    
    If Carryon = vbYes Then
        Dim shName As String
        Dim currentName As String
    
        currentName = ActiveSheet.Name
      
        shName = InputBox("Type new Worksheet name")
        If shName <> "" Then
            ThisWorkbook.Sheets(currentName).Name = shName
        End If
    End If
    
End Sub
cpjpxq1n

cpjpxq1n2#

您已经将Carryon声明为字符串变量- vbYes(和其他消息框结果)是数值常量。

kdfy810k

kdfy810k3#

如果用户按“取消”,则InputBox-Function返回空字符串(“”)。如果尝试使用该空字符串作为工作表名称,则会出现运行时错误(因为这不是有效的工作表名称),并触发错误处理程序。
要避免这种情况,只需在指定名称之前检查shName是否不是空字符串。

If MsgBox("Change Worksheet Name?", vbYesNo) <> vbYes Then Exit Sub

Dim currentSheet As Worksheet, shName As String
Set currentSheet = ActiveSheet
shName = InputBox("Type new Worksheet name")
If shName <> "" Then
    currentSheet.Name = shName
End If
o8x7eapl

o8x7eapl4#

可以使用StrPtr来处理InputBox。这是一个未公开的函数,用于获取变量的底层内存地址。
下面是一个例子

shName = InputBox("Type new Worksheet name")

If (StrPtr(shName) = 0) Or (shName = "") Or Len(Trim(shName)) = 0 Then
    '~~> StrPtr(shName) = 0 : User Pressed Cancel, or the X button
    '~~> shName = "" : User tried to pass a blank value
    '~~> Len(Trim(shName)) = 0 : User tried to pass space(s)
    
    Exit Sub ' Or do what you want
Else
    MsgBox "Worksheet Name: " & shName
End If
3b6akqbq

3b6akqbq5#

请尝试下一种方法:

Sub MsgBoxYesNoHandling()
   Dim Carryon As VbMsgBoxResult, shName As String
   
   Carryon = MsgBox("Change Worksheet Name?", vbYesNo)
   If Not Carryon = vbYes Then Exit Sub
   
   shName = InputBox("Type new Worksheet name")
   If Len(Trim(shName)) = 0 Then Exit Sub
   
   'do here whatever you need..
End Sub
svdrlsy4

svdrlsy46#

重命名工作表

  • 此操作将重命名所有活动工作表(工作表或图表),而不仅仅是包含此代码的工作簿中的活动工作表(ThisWorkbook)。在退出之前,仅当操作成功时才会显示消息框。
Sub RenameSheet()
    Const PROC_TITLE As String = "Rename Sheet"
    On Error GoTo ClearError ' start main error-handling routine
    
    Dim sh As Object: Set sh = ActiveSheet
    If sh Is Nothing Then
        MsgBox "No visible workbooks open.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    Dim OldName As String: OldName = sh.Name
    
    Dim NewName As String, MsgNumber As Long
    
    Do
        NewName = InputBox("Input the new sheet name:", PROC_TITLE, OldName)
        If Len(NewName) = 0 Then Exit Sub
        
        On Error GoTo RenameError ' start Rename error-handling routine
            sh.Name = NewName
        On Error GoTo ClearError ' restart main error-handling routine
        
        Select Case MsgNumber
            Case 0, vbNo: Exit Do
            Case vbYes: MsgNumber = 0 ' reset for the next iteration
        End Select
    Loop
            
    If MsgNumber = 0 Then
        If StrComp(OldName, NewName, vbBinaryCompare) = 0 Then Exit Sub
        MsgBox "Sheet renamed from '" & OldName & "' to '" & NewName & "'.", _
            vbInformation, PROC_TITLE
    End If
    
ProcExit:
    Exit Sub
RenameError: ' continue Rename error-handling routine
    MsgNumber = MsgBox("Could not rename from '" & OldName & "' to '" _
        & NewName & "'. Try again?" & vbLf & vbLf & "Run-time error '" _
        & Err.Number & "':" & vbLf & vbLf & Err.Description, _
        vbYesNo + vbQuestion, PROC_TITLE)
    Resume Next
ClearError: ' continue main error-handling routine
    MsgBox "An unexpected error occurred." _
        & vbLf & vbLf & "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub

相关问题