Bẫy lỗi thế nào đối với InputBox nếu người dùng bấm Cancel (1 người xem)

[AnhThu-1976]

Em muốn bẫy lỗi trong code như sau:

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
'On Error Resume Next
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
'On Error GoTo 0

Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)

For i = 1 To Nguon.Rows.Count
Do Until Not Dich.Offset(r).Rows.Hidden
r = r + 1
Loop
Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
r = r + 1

Next i

End Sub

Khi hộp Input box hiện ra và hỏi "Chon vung copy" nếu em không muốn chọn và bấm cancel thì bị lỗi
Em có dùng On Error Resume Next để bẫy lỗi nhưng em dùng chưa đúng.
Em muốn khi bấm Cancel thì thoát luôn code, nhờ các anh/chị hướng dẫn thêm. Em cảm ơn!

 

[vu_tuan_manh_linh]

Theo tôi thì nên đặt On Error Goto ExitSub ngay trước phần khai báo biến, trong đó ExitSub đặt ngay trước End Sub.

Sub Paste_to_Visible_Rows()
On Error GoTo Exitsub
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)
For i = 1 To Nguon.Rows.Count
    Do Until Not Dich.Offset(r).Rows.Hidden
        r = r + 1
    Loop
    Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
    r = r + 1
Next i
Exitsub:
End Sub

 

[SA_DQ]

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim I As Long, R As Long
On Error GoTo LoiCT           '
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)
For I = 1 To Nguon.Rows.Count
    Do Until Not Dich.Offset(R).Rows.Hidden
        R = R + 1
    Loop
    Nguon.Rows(I).Copy Destination:=Dich.Offset(R)
    R = R + 1
Next I
Err_:    Exit Sub
LoiCT:
If Err = 424 Then
    MsgBox "Cân Chon Vùng Chép Dên!", , "GPE.COM Xin Luu Ý!"
    Resume Err_
Else
    MsgBox Err
    On Error Resume Next
End If
End Sub

Thử xem, bạn!

 

[ndu96081631]

Em muốn bẫy lỗi trong code như sau:

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
'On Error Resume Next
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
'On Error GoTo 0

Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)

For i = 1 To Nguon.Rows.Count
Do Until Not Dich.Offset(r).Rows.Hidden
r = r + 1
Loop
Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
r = r + 1

Next i

End Sub

Khi hộp Input box hiện ra và hỏi "Chon vung copy" nếu em không muốn chọn và bấm cancel thì bị lỗi
Em có dùng On Error Resume Next để bẫy lỗi nhưng em dùng chưa đúng.
Em muốn khi bấm Cancel thì thoát luôn code, nhờ các anh/chị hướng dẫn thêm. Em cảm ơn!

Mấu chốt nằm ở chỗ này: Làm sao cho code biết được Nguon và Dich không phải Range nếu bấm Cancel? Vậy ta sẽ:

Dim Nguon As Object, Dich As Object

Tức khai báo 2 biến dạng Object thay vì là Range. Tiếp theo là code bẫy lỗi:

On Error Resume Next
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
On Error GoTo 0
If TypeName(Nguon) = "Range" Then
  ... làm gì đó tùy bạn
End If

Làm tương tự thế khi xét biến Dich

 

[befaint]

@chủ thớt: Tham khảo

Sub Vidu()
    Dim Range_Nguon As Range, Range_Dich As Range, RngInput
    RngInput = Application.InputBox("Chon mot vung tren bang tinh", Array("Chon vung nguon", "Chon vung dich"), Type:=8)
    '// Bây lôi
    If VarType(RngInput(LBound(RngInput))) = vbBoolean _
        Or VarType(RngInput(LBound(RngInput) + 1)) = vbBoolean Then Exit Sub '// Neu Cancel
   
    Set Range_Nguon = RngInput(LBound(RngInput))
    Set Range_Dich = RngInput(LBound(RngInput) + 1)
    MsgBox Range_Nguon.Address
    MsgBox Range_Dich.Address
End Sub

 

[Hoàng Nhật Phương]

@chủ thớt: Tham khảo

Sub Vidu()
    Dim Range_Nguon As Range, Range_Dich As Range, RngInput
    RngInput = Application.InputBox("Chon mot vung tren bang tinh", Array("Chon vung nguon", "Chon vung dich"), Type:=8)
    '// Bây lôi
    If VarType(RngInput(LBound(RngInput))) = vbBoolean _
        Or VarType(RngInput(LBound(RngInput) + 1)) = vbBoolean Then Exit Sub '// Neu Cancel
  
    Set Range_Nguon = RngInput(LBound(RngInput))
    Set Range_Dich = RngInput(LBound(RngInput) + 1)
    MsgBox Range_Nguon.Address
    MsgBox Range_Dich.Address
End Sub

Xin chào befaint
Có thể giải thích giúp OT tại sao RngInput lại +1 được không?
Theo OT hiểu có phải: Array("Chon vung nguon", "Chon vung dich") <=> Array(0, 1)
Cảm ơn befaint.

 

[HieuCD]

Xin chào befaint
Có thể giải thích giúp OT tại sao RngInput lại +1 được không?
Theo OT hiểu có phải: Array("Chon vung nguon", "Chon vung dich") <=> Array(0, 1)
Cảm ơn befaint.

Copy, dán, chỉnh biến, +1 cho lẹ

 

[SA_DQ]

Ứng dụng hàm Erl xem sao:

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
Dim MsgB As String

On Error GoTo LoiCT
1 Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
2 Set Dich = Application.InputBox(prompt:="Chep Den: (luu Ý: Chi Chon 1 Ô Dâu Tiên Cua Vùng Cân Dán:", Type:=8)
3 For i = 1 To Nguon.Rows.Count
    Do Until Not Dich.Offset(r).Rows.Hidden
        r = r + 1
    Loop
    Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
    r = r + 1
Next i
Err_:           Exit Sub
LoiCT:
If Err = 424 Then
    MsgB = Choose(Erl, "Vùng Copy", "Vùng Dán", "GPE.COM")
    MsgBox "Cân Chon  " & MsgB ,  , "GPE.COM Xin Luu Ý!"
    Resume Err_
Else
    On Error Resume Next
End If
End Sub

 

[thanhlong.hygt]

Ứng dụng hàm Erl xem sao:

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
Dim MsgB As String

On Error GoTo LoiCT
1 Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
2 Set Dich = Application.InputBox(prompt:="Chep Den: (luu Ý: Chi Chon 1 Ô Dâu Tiên Cua Vùng Cân Dán:", Type:=8)
3 For i = 1 To Nguon.Rows.Count
    Do Until Not Dich.Offset(r).Rows.Hidden
        r = r + 1
    Loop
    Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
    r = r + 1
Next i
Err_:           Exit Sub
LoiCT:
If Err = 424 Then
    MsgB = Choose(Erl, "Vùng Copy", "Vùng Dán", "GPE.COM")
    MsgBox "Cân Chon  " & MsgB ,  , "GPE.COM Xin Luu Ý!"
    Resume Err_
Else
    On Error Resume Next
End If
End Sub

Nếu sửa thành paste Link thì sửa như nào bác ơi. e gà lên tìm các kiểu vẫn k làm được