excel - 取消时Application.InputBox错误424

Question

我正在使用一个子控件，该子控件调用一个输入框，以复制工作表中的选定单元格并将其粘贴到多列列表框中。我终于使所有工作正常，除了当用户取消输入框时出现错误424之外。我已经通读了无数关于该错误的帮助线程，却发现似乎没有什么可以为我处理该错误。我希望外面的人可以告诉我下面的代码是否有问题(除了1200万个退出子程序来阻止该错误)，或者可能让我对另一个 Realm 有所了解(声明，初始化，激活？)。我应该检查一下。任何想法表示赞赏，谢谢。

Private Sub CopyItemsBtn_Click()
Dim x As Integer
Dim rSelected As Range, c As Range
Dim wb
Dim lrows As Long, lcols As Long
x = ProformaToolForm.ItemsLB.ListCount

'Prompt user to select cells for formula
On Error GoTo cleanup
wb = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")
If wb <> False Then
    Workbooks.Open wb
End If

Set rSelected = Application.InputBox(Prompt:= _
                "Select cells to copy", _
                Title:="Transfer Selection", Type:=8)
If Err.Number = 424 Then
    Debug.Print "Canceled"
    Exit Sub
ElseIf Err.Number <> 0 Then
    Debug.Print "unexpected error"
    Exit Sub
End If

If rSelected.Rows.Count < 1 Or rSelected.Columns.Count < 1 Then
    Exit Sub
End If
Err.Clear
On Error GoTo 0

'Only run if cells were selected and cancel button was not pressed
If Not rSelected Is Nothing Then
    For Each c In rSelected
        With ProformaToolForm.ItemsLB
            .AddItem
            .List = rSelected.Cells.Value
        End With
    Next
Else
    Exit Sub
End If
cleanup: Exit Sub
End Sub

经过一些清理后，这是我对Tim的代码的尝试:

Private Sub CopyItemsBtn_Click()
Dim rSelected As Range, c As Range
Dim wb

wb = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")

If wb <> False Then
    Workbooks.Open wb
End If

'Prompt user to select cells for formula
On Error Resume Next
Set rSelected = Application.InputBox(Prompt:= _
                "Select cells to copy", _
                Title:="Transfer Selection", Type:=8)
On Error GoTo 0

If rSelected Is Nothing Then
    MsgBox "no range selected", vbCritical
    Exit Sub
End If

For Each c In rSelected
    With ProformaToolForm.ItemsLB
        .AddItem
        .List = rSelected.Cells.Value
    End With
Next

End Sub

Answer 1

这是我倾向于这样做的方式:

Private Sub CopyItemsBtn_Click()

    Dim rSelected As Range

    On Error Resume Next
    Set rSelected = Application.InputBox(Prompt:= _
                "Select cells to copy", _
                Title:="Transfer Selection", Type:=8)
    On Error GoTo 0

    If rSelected Is Nothing Then
        MsgBox "no range selected!", vbCritical
        Exit Sub
    End If

    'continue with rSelected

End Sub