输入框取消Excel VBA

Question

此代码复制了一组excel数据（Col A至Col BH），并提示用户选择复制的模板需要粘贴的行。 该代码似乎可以正常工作（随时清理/优化任何代码），我的问题是，当用户需要取消选择行时单击取消时，会出现错误“运行时错误13类型不匹配”。 如果选择了取消，是否还有结束宏的方法呢？

 Sub CopyTemplate()

Worksheets("HR-Calc").Activate
Dim rng As Variant
Dim trng As Range
Dim tco As String
Dim hi As String
Dim de As String
'Use the InputBox select row to insert copied cells
Set rng = Application.InputBox("select row to paste into", "Insert template location", Default:=ActiveCell.Address, Type:=8)

startrow = rng.Row
'  MsgBox "row =" & startrow
Range("Bm2") = startrow

Application.ScreenUpdating = False

'copy template block
Range("C6").End(xlDown).Select

Range("bm1") = ActiveCell.Offset(1, 0).Row

Worksheets("HR-CAlc").Activate
tco = "A6:bh" & Range("bm1")
Range(tco).Select
Selection.Copy
Range("A" & Range("bm2")).Activate
Selection.Insert Shift:=xlDown

Range("c100000").End(xlUp).Select
Selection.End(xlUp).Select

'mycell.Select

''Use the InputBox to select text to be replaced
''Set rep = Application.InputBox("select data range where text will be replaced", Default:=ActiveCell.Address, Type:=8)
'Set rep = ActiveCell
'    Told = Application.InputBox("Find the text that needs to be replaced", "Find text in Input data", Default:=ActiveCell.Value, Type:=2)
'    If Told = "" Or vbCancel Then
'    End If
'
'    Tnew = Application.InputBox("Input desired text", "Replace text in data", Default:=ActiveCell.Value, Type:=2)
'    If Tnew = "" Or vbCancel Then
'    End If
'
'        rep.Select
'        Selection.Replace What:=Told, Replacement:=Tnew, LookAt:=xlPart, _
'        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'        ReplaceFormat:=False

Range("bm1:bm2").ClearContents
SendKeys "{F2}"
SendKeys "{BS}"
Application.ScreenUpdating = True


End Sub

Answer 1

您仍然需要错误处理才能检测到“取消”

Dim rng As Range  '<~~~ change type so If test will work
'Use the InputBox select row to insert copied cells
Set rng = Nothing  ' in case it was previously set
On Error Resume Next
Set rng = Application.InputBox("select row to paste into", "Insert template location", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0 ' or your error handler
If rng Is Nothing Then
    ' User canceled, what now?
    Exit Sub 'maybe...
End If

Answer 2

添加这些行，包括错误处理程序 ：

On Error Resume Next
Set rng = Application.InputBox("select row to paste into", "Insert template location", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0
If IsEmpty(rng) = True Then
   Exit Sub
End If  

如果找不到rng任何值，这些行将退出子。