VBA Nâng cao: Phương pháp tạo thủ tục với hai kiểu gọi Single Call và Double Call

[HeSanbi]

Hôm nay tôi hướng dẫn các bạn một phương pháp lập trình nâng cao mới, nhầm tạo một thủ tục với hai chế độ gọi (bài viết này chỉ nói về chủ đề này) là gọi một lần (Single Call) và gọi hai lần liên tục (Double Call).

Như thế nào là chế độ gọi?

Chẳng hạn như gọi hàm hoặc thủ tục từ một control, một Shape, nút nhấn trên Ribbon, nút nhấn trên Menu Context (Menu khi nhấn chuột phải), phím tắt người dùng tạo,... , có hành động nhấn từ chuột hoặc Bàn Phím. Thường thì chúng chỉ có một hành động chuột là Click, hoặc phím nhấn 1 lần là thực thi. Thì nay có phương pháp Double Call, thì ta có thể thêm sự kiện Double Click.​

Như thế nào là Single Call và Double Call?

Là khi gọi thủ tục thì nếu sự kiện Double Call được bắt thì Single Call sẽ bị hủy. Gọi Single Call Trong khoảng thời gian 75 đến 170 mili giây, nếu không bắt được sự kiện Double Call, thì gọi Single Call thành công.​

Với một thủ tục có hai chế độ gọi như vậy sẽ giúp các bạn có thể thêm chức năng thứ hai cho thủ tục bạn tạo. Rất tiện dụng cho nhiều trường hợp.


Ưu điểm của phương pháp này như:

1. Nếu gọi thủ tục bởi nút nhấn, vừa nhấn vừa dịch chuyển chuột, thì quá trình gọi thủ tục sẽ bị hủy bỏ.
2. Áp dụng vào phím tắt, để di chuyển trang tính: Bạn chỉ cần tạo một phím tắt gán thủ tục, nhấn phím tắt một lần sẽ về trang trước đó, nhấn hai lần để quay trở lại.
3. Tạo nút nhấn có chế độ Double Click cho Nút nhấn trong trang tính.

Để tạo được chế độ Double Call ta cần sử dụng Hàm WinApi, để tạo một Callback Function, sẽ gọi lại thủ tục với một khoảng thời gian đủ để lần nhấn thứ hai thành công. Thời gian mỗi lần cho mỗi hai lần nhấn giao động trong khoảng 75 đến 170 mili giây.

Mã dưới đây đã được tạo để thực hiện mục tiêu như trên, với hàm ProcCaller có nhiệm vụ điều khiển lần gọi, để bắt sự kiện gọi hai lần liên tục.

Tạo một thủ tục và gọi hàm ProcCaller trong thủ tục bạn tạo với đối số đầu là tên của thủ tục đã tạo, đối số thứ hai là khoảng thời gian đủ để bắt lần gọi thứ hai.

Hàm ProcCaller trả lại các giá trị -1,0, 1, và 2 đại diện cho hành động: Đã hủy hành động, không làm gì cả, đã gọi một lần và đã gọi hai lần liên tục.


Ví dụ: bạn cần tạo thủ tục HelloWorld1

Private Sub HelloWorld1()
  Select Case ProcCaller("HelloWorld1")
  Case 1: Debug.Print "ProcCaller: Single Call"
  Case 2: Debug.Print "ProcCaller: Double Call"
  End Select
End Sub

Hoặc thêm thời gian đủ để bắt sự kiện gọi lần hai, đơn vị 1/1000 của giây:

Private Sub HelloWorld2()
  Select Case ProcCaller("HelloWorld2",0.15)
  Case 1: Debug.Print "ProcCaller: Single Call"
  Case 2: Debug.Print "ProcCaller: Double Call"
  End Select
End Sub

Hoặc thủ tục cần nhận đối số:

Private Sub HelloWorld3(Optional Byval Direction%, Optional Byval Action%, Optional Byval Text$)
  Select Case ProcCaller("HelloWorld3 " & cstr(Direction) & "," & cstr(Action) & ",""" & Replace(Replace(Text,"'","''"),"""","""""") & """"
  Case 1: Debug.Print "ProcCaller: Single Call"
  Case 2: Debug.Print "ProcCaller: Double Call"
  End Select
End Sub

Hoặc thủ tục cần nhận đối số là đối tượng - Object, thì thêm khai báo Static:

Private Sub HelloWorld4(Optional Byval control as Object)
  Static stControl as Object
  Select Case ProcCaller("HelloWorld4")
  Case 0: Set stControl = control 
  Case 1: Debug.Print "ProcCaller: Single Call" 'Gọi lại stControl
  Case 2: Debug.Print "ProcCaller: Double Call" 'Gọi lại stControl
  End Select
End Sub

Để bỏ qua ProcCaller bắt sự kiện tạm thời, để gọi một sự kiện hoặc không, ta cần thêm đối số OnlyEvent:
ProcCaller("HelloWorld4", OnlyEvent:=1)


Dưới đây là mã viết một lần duy nhất cho mọi thủ tục có hai chế độ Single và Double, với hàm chính là ProcCaller
(Hãy sao chép mã vào một Module mới)

Option Explicit
Option Private Module

Private Type POINTAPI
    x As Long
    y As Long
End Type
#If VBA7 And Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongLong, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
#ElseIf VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "user32" (p As POINTAPI) As Long
#Else
Private Declare Function GetCursorPos Lib "user32" (p As POINTAPI) As Long
#End If

Private Type v64
#If VBA7 And Win64 Then
'z As LongLong
'#ElseIf VBA7 Then
z As LongPtr
#Else
z As Long
#End If
End Type

Private Enum IdEventProcTimer
    IdEventProcedureCall = 1001
End Enum
Private Type ProcCallerDirective
  hwnd As v64
  IdEvent As v64
  click As Integer
  OnAction As String
  SpaceTime As Single
  Timer As Single
  Cursor As POINTAPI
End Type
Private PCD As ProcCallerDirective
Function ProcCaller( _
                     Optional ByVal OnAction As String, _
                     Optional ByVal SpaceTime As Double = 0.155, _
                     Optional ByVal OnlyEvent%) As Integer
  On Error Resume Next
  With PCD
    If OnlyEvent > 0 Then .click = 0: .Timer = 0: ProcCaller = OnlyEvent: Exit Function
    If .click = 1 Then .click = 0: .Timer = 0: ProcCaller = 1: Exit Function
    If .Timer < Timer And .click = 0 Then
      ProcCaller = 0
      GetCursorPos .Cursor
      .OnAction = OnAction
      .click = -1
      .Timer = Timer + SpaceTime
      .hwnd.z = Application.hwnd
      .IdEvent.z = IdEventProcedureCall
      Call SetTimer(.hwnd.z, IdEventProcedureCall, SpaceTime * 1000, AddressOf TimerProc_ButtonClick)
    Else
      ' DblClick
      Dim p As POINTAPI:  GetCursorPos p
      If p.x = .Cursor.x And p.y = .Cursor.y Then ProcCaller = 2 Else [SIZE=5]ProcCaller = -2[/SIZE]
      KillTimer .hwnd.z, .IdEvent.z: .click = 0
    End If
  End With
  Err.Clear
End Function
#If VBA7 And Win64 Then
Private Sub TimerProc_ButtonClick(ByVal hwnd As LongPtr, ByVal wMsg^, ByVal IdEvent As LongPtr, ByVal dwTime^)
#ElseIf VBA7 Then
Private Sub TimerProc_ButtonClick(ByVal hwnd As LongPtr, ByVal wMsg&, ByVal IdEvent As LongPtr, ByVal dwTime&)
#Else
Private Sub TimerProc_ButtonClick(ByVal hwnd&, ByVal wMsg&, ByVal IdEvent&, ByVal dwTime&)
#End If
  On Error Resume Next
  KillTimer hwnd, IdEvent
  Select Case IdEvent
  Case IdEventProcedureCall:
    With PCD
      If .OnAction <> Empty And .click = -1 Then
        Dim p As POINTAPI:  GetCursorPos p
        If p.x = .Cursor.x And p.y = .Cursor.y Then
          .click = 1: Application.OnTime Now, onProject(.OnAction)
        End If
      End If
    End With
  End Select
End Sub
Private Function onProject(ByVal Procedure$, Optional ByVal project$ = vbNullChar) As String
  ' OnTime: 'Procedure 1'
  ' OnAction, AssignMacro: Procedure (1)
  If project = vbNullChar Or project = Empty Then project = ThisWorkbook.Name
  If Procedure Like "'*'!*" Then
    onProject = Procedure
  Else
    If Procedure Like "*)" Or Not Procedure Like "* *" Then
      onProject = "'" & Replace(project, "'", "''") & "'!" & Procedure
    Else
      onProject = "'" & Replace(project, "'", "''") & "'!'" & Procedure & "'"
    End If
  End If
End Function

Chúc các bạn thành công!

Phương pháp lập trình để tạo Effect cho nút nhấn trong trang tính được viết trong bài viết dưới đây, các bạn có thể tham khảo thêm!

Các Hàm quản lý ảnh: vị trí, kích thước, cắt, xóa, sắp xếp

Hôm nay tôi chia sẻ với bạn các Hàm bổ trợ quản lý ảnh cực kỳ thú vị, chức năng bao gồm: chỉnh vị trí, kích thước, cắt, xóa và sắp xếp ảnh một cách đơn giản, thuận tiện và nhanh gọn, giúp các bạn bớt khó khăn trong việc tinh chỉnh ảnh khi trong trang tính của bạn có quá nhiều đối tượng hình ảnh...

www.giaiphapexcel.com

 

[ptm0412]

Nó có giống thế này không:

Sub Btn1_Click()
   If Btn1.Caption = "Run" Then
       Btn1.Caption = "Stop"
       Msgbox "You are running"
   Else
       Btn1.Caption = "Run"
       Msgbox "You stop running"
   End If
End Sub

Ba, bốn trường hợp thì thêm Else If

 

[HeSanbi]

@ptm0412
Hàm tạo của bác chỉ tương tự nút bật tắt đèn, nếu ElseIf thì tương tự công tắc có nhiều chế độ bật.

Không thể giống phương pháp ở trên được.

Để hiểu rõ phương pháp trên rất đơn giản, bác chỉ cần gọi hàm liên tục 10 lần, thì chỉ có 5 cuộc gọi lại và trả về là Double Call.

Với thủ tục của bác thì gọi 10 lần liên tục thì trả lại đúng 10 lần và luôn phiên trả bật, tắt.

Phương pháp trên bao gồm cả Sự kiện Click và DblClick của control nhưng được tích hợp trong một thủ tục duy nhất.

 

[ptm0412]

@ptm0412
bác chỉ cần gọi hàm liên tục 10 lần, thì chỉ có 5 cuộc gọi lại và trả về là Double Call.

Tôi có thể tạo 1 biến public, hoặc lưu xuống 1 ô trong sheet giá trị 1 hoặc 2, cộng thêm 1giá trị timer ở ô khác là được.

If Sheet1![A1].Value = 2 And (Timer - Sheet1![A2].Value) <= 1 Then

 

[HeSanbi]

ptm0412​

Tất cả những gì bác đang nghĩ và suy luận, trước đó tôi đã suy luận đầy đủ và có đủ lý do tại sao để viết nên phương pháp trên.

Viết mã theo phương pháp thường không thể đạt được mục tiêu như ở trên.

 

[ptm0412]

Trong phạm vi nhu cầu thông thường thì tôi nghĩ như vậy là đủ. Những trường hợp rất đặc thù và rất hiếm thì nếu không nói rõ sẽ làm mọi người sợ không dám học.

 

[huuthang_bd]

Tôi thấy viết theo phương pháp thông thường như thế này vẫn chạy ầm ầm mà.

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Private bClick As Boolean
Sub Click()
    bClick = Not bClick
    If bClick Then
        Sleep 200
        Application.OnTime Now(), "SingleClick"
    Else
        DoubleClick
    End If
End Sub
Private Sub SingleClick()
    If bClick Then
        doSingleClick
        bClick = False
    End If
End Sub
Private Sub DoubleClick()
    doDoubleClick
End Sub

 

[HeSanbi]

Dùng Api là phương pháp bình thường? Nhấn là con trỏ chuột quay quay rối mắt là bình thường? Cứ như con chuột bị mắc chứng đầy hơi.

Tôi thấy hàm Sleep Bất ổn mà bác gọi là bình thường?

Nhấn vào vừa di chuyển trỏ chuột mã vẫn chạy là bình thường?
Nhấn vào hai điểm khác nhau trên nút gọi mã nhận diện là Double Click là bình thường?

 

[HeSanbi]

Gán vào phím tắt. Tự nhiên nhấn phím mà con chuột lại xoay xoay vòng vòng, quay quay vòng vòng, xoay xoay tròn tròn, quay quay tròn tròn. Người dùng tưởng chuột "Made In Ch.."

Bài đã được tự động gộp: 20/2/23

Bài viết tôi có chủ đề VBA Nâng Cao chứ đâu phải biểu diễn chạy cho đúng ý là được mà thiếu cái chuẩn xác, cái đẹp, cái bắt mắt đâu bác.

 

[huuthang_bd]

Thì tôi nói tôi viết theo phương pháp thông thường chứ có nói phương pháp của bạn không nâng cao đâu.
Bạn là nhất nhé

 

[HeSanbi]

Tôi có nói bác về nhì đâu, mà bác cho tôi nhất.
Bác hiểu nhầm bài viết của tôi, bài viết của tôi không phải cuộc thi. Mà chia sẻ kiến thức, kinh nghiệm.

 

[UltraExcel]

Hình như kỹ thuật này chỉ để tạo sự kiện double click là ý nghĩa nhất bạn nhỉ?

 

[HeSanbi]

Ví dụ bạn gọi thủ tục từ phím tắt thì không thể dùng từ Double Click, tôi định nghĩa là Chế độ gọi, với tôi phương pháp trên tôi có thể tận dụng viết mã cho nhiều giải thuật, chứ không riêng gì 1 sự kiện Double Click, sắp tới một dự án mang toàn bộ tinh túy của phương pháp trên, và có thể là một bất ngờ! sẽ được chia sẻ.

 

[UltraExcel]

Ví dụ bạn gọi thủ tục từ phím tắt thì không thể dùng từ Double Click, tôi định nghĩa là Chế độ gọi, với tôi phương pháp trên tôi có thể tận dụng viết mã cho nhiều giải thuật, chứ không riêng gì 1 sự kiện Double Click, sắp tới một dự án mang toàn bộ tinh túy của phương pháp trên, và có thể là một bất ngờ! sẽ được chia sẻ.

Nếu không phải dùng cho tương tác double click thì có lẽ nó chỉ dùng với một ít trường hợp đặc biệt nào đó nhỉ. Vì mình thấy khá rắc rối để chạy một macro.

 

[HeSanbi]

Nếu không phải dùng cho tương tác double click thì có lẽ nó chỉ dùng với một ít trường hợp đặc biệt nào đó nhỉ. Vì mình thấy khá rắc rối để chạy một macro.

Vậy trên Ribbon tự tạo, tôi cần có 50 nút với sự kiện Double Click bạn có thể giúp tôi viết mã không rắc rối nhưng đầy đủ yếu tố như trên được không.
Tôi không đủ Nơron để nghĩ ra giải pháp khác. Tôi chỉ học được bao nhiêu đó kinh nghiệm.

Tôi thấy gọi lại chỉ duy nhất hàm ProcCaller mà bạn kêu rối thì tôi chịu thua rồi. Gặp thanh niên học tập sợ mã dài. Trong khi mã hỗ trợ chưa đến 100 dòng.

 

[UltraExcel]

Hoàn toàn cổ cũ cho việc bạn chia sẻ kiến thức nhé. Bây giờ chia sẻ kiến thức độc lạ là quý mà. Mình chỉ muốn tìm lý do ứng dụng cho kỹ thuật này thôi. Các menu thường hay là loại ribbon thì người ta chỉ dùng một click chuột, không cần thiết phải dùng đến double click, nên trên ribbon người ta thiết kế như vậy chắc là ổn rồi. Ngay cả trên Userform, tạo một nút bấm command button chả nhẽ phải bấm 2 lần? Vì những lý do đó mà mình muốn tìm hướng khi nào thì dùng kỹ thuật này mà thôi. Chắc đợi bài chia sẻ khác của bạn đẻ khai thông sự tò mò này của mình.