Question

我正在使用一个子调用输入框来复制工作表中的选定单元格并将其粘贴到多列列表框中。当用户取消输入框时，我终于使一切正常，除了错误424。我已经阅读了无数关于此错误的帮助主题，并且没有找到任何似乎能够为我处理错误的内容。我希望有人可以告诉我下面的代码是否有问题（除了1200万次出口子尝试停止错误），或者可能让我知道另一个区域（声明，初始化，激活）？）我应该检查。任何想法都表示赞赏，谢谢。

[['A', 'B']] =

经过一些清理，这是我对蒂姆代码的尝试：

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

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

Answer 2

找到了一个解决方案，来自Dirk的最后一篇帖子here。对于任何感兴趣的人，这是工作代码：

Private Sub CopyItemsBtn_Click()
Dim rSelected As Range
Dim wb
Dim MyCol As New Collection

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

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

MyCol.Add Application.InputBox(Prompt:= _
            "Select cells to copy", _
            Title:="Transfer Selection", Type:=8)

If TypeOf MyCol(1) Is Range Then Set MyRange = MyCol(1)
Set MyCol = New Collection
If rSelected Is Nothing Then
    MsgBox "no range selected", vbCritical
    Exit Sub
End If

ProformaToolForm.ItemsLB.List = rSelected.Value
End Sub

取消时Application.InputBox错误424

2 个答案: