Mẹo Office 100% nên biết: Chỉ cần gán một Macro duy nhất cho tất cả Shape

Liên hệ QC
HeSanbi

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
Tham gia
24/2/13
Bài viết
2,382
Được thích
3,536
Giới tính
Nam
Chắc chắn 100% những ai đã từng gán hơn 100 macro vào Shape, label, button,.. sẽ nói "tuyệt quá, tuyệt vời quá"

Có phải bạn đang tạo một Đối tượng rồi gán một Macro vào đối tượng đó để thực hiện một tác vụ nào đó, cứ mỗi đối tượng là mỗi Macro khác nhau. Nếu như Dự án của bạn có đến Hàng trăm, có khi hàng nghìn Đối tượng cần gán Macro như vậy. Thật là vất vả phải không các bạn?
(Đối tượng bao gồm Hình ảnh, Label, Button, ...)

Bài viết này tôi sẽ hướng dẫn cho các bạn chỉ cần gán một Macro duy nhất vào tất cả các Đối tượng mà bạn cần gán vào.


Nhiều bạn học lập trình VBA có thể chưa biết khi Macro được gọi từ một Đối tượng trong trang tính Excel thì tên của Shape sẽ được trả về ngay lúc gọi là phương thức Application.Caller. Chính vì vậy mà ta có thể gán duy nhất một Macro vào tất cả các Đối tượng đó.

Hướng dẫn:
Tạo một Macro SuperCall chung cho tất cả các đối tượng mà phương thức Application.Caller nhận được tên của đối tượng đó.
Gán toàn bộ Đối tượng với Macro SuperCall.
Đổi tên từng đối tượng sao cho tên phải khác nhau.
(đổi tên bằng Code VBA nếu cần để nhanh hơn)



Code hướng dẫn:
PHP: 
Sub SuperCall()
    If VBA.TypeName(Application.Caller) <> "String" Then Exit Sub
    Select Case Application.Caller
    ''------------------------------
    ''Tên đối thường là:
    Case "NewShape1"
        ''Thì thực hiện
        Select Case ActiveSheet.Name
        Case "Sheet1": MsgBox "Clicked NewShape1 Sheet1"
        Case "Sheet2": MsgBox "Clicked NewShape1 Sheet2"
        Case Else:
             MsgBox "Any Sheet"
        End Select
    Case "NewShape2": Call HelloWorld_Call
    ''------------------------------
    ''Nếu tên của đối tượng cũng là tên của một thủ tục thì:
    Case Else:  Application.OnTime VBA.Now(), Application.Caller
     ''------------------------------
    End Select
End Sub

Sub SuperShape1()
    MsgBox "Clicked SuperShape1"
End Sub

Sub HelloWorld_Call()
    MsgBox "Call HelloWorld_Call"
End Sub

Sub Group1_Shape1()
    MsgBox "Call Group1_Shape1"
End Sub
---------------------


Dùng Code để gán Macro cho toàn bộ các đối tượng:
---------------------
PHP: 
Sub AssignMacroAll()
  '(BoÒ dâìu ' ðêÒ doÌng code ðýõòc thýòc hiêòn)
  On Error Resume Next
  Dim WS, O
  For Each WS In Worksheets
    ''Gán cho tâìt caÒ Shape
    ''WS.DrawingObjects.OnAction = "SuperCall"
    For Each O In WS.DrawingObjects
       ''Nêìu ðôìi týõòng có chýìa tên thiÌ gán
       ''If O.name Like "*Rectangle*" Then .OnAction = "SuperCall"

       ''Nêìu ðôìi týõòng ðaÞ ðýõòc gán Macro týÌ trýõìc ðó thiÌ gán thành SuperCall
       ''If .OnAction <> "" Then .OnAction = "SuperCall"
       ''Nêìu ðôìi týõòng ðaÞ ðýõòc gán Macro týÌ trýõìcthiÌ không làm giÌ caÒ, coÌn laòi thiÌ ...
       ''If .OnAction = "" Then
       ''   .OnAction = "..."
       ''End iF
    Next
  Next
End Sub
-------------------

Ở trên tôi đã hướng dẫn cho các bạn tạo duy nhất một Macro cho tất cả Đối tượng. Và tôi có những bài viết về VBA các bạn có thể tham khảo thêm bằng cách vào trang cá nhân của tôi trên Giải Pháp Excel này.

Chúc các bạn thành công!
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
HeSanbi đã viết:
Chắc chắn 100% những ai đã từng gán hơn 100 macro vào Shape, label, button,.. sẽ nói "tuyệt quá, tuyệt vời quá"

Có phải bạn đang tạo một Đối tượng rồi gán một Macro vào đối tượng đó để thực hiện một tác vụ nào đó, cứ mỗi đối tượng là mỗi Macro khác nhau. Nếu như Dự án của bạn có đến Hàng trăm, có khi hàng nghìn Đối tượng cần gán Macro như vậy. Thật là vất vả phải không các bạn?
(Đối tượng bao gồm Hình ảnh, Label, Button, ...)

Bài viết này tôi sẽ hướng dẫn cho các bạn chỉ cần gán một Macro duy nhất vào tất cả các Đối tượng mà bạn cần gán vào.


Nhiều bạn học lập trình VBA có thể chưa biết khi Macro được gọi từ một Đối tượng trong trang tính Excel thì tên của Shape sẽ được trả về ngay lúc gọi là phương thức Application.Caller. Chính vì vậy mà ta có thể gán duy nhất một Macro vào tất cả các Đối tượng đó.

Hướng dẫn:
Tạo một Macro SuperCall chung cho tất cả các đối tượng mà phương thức Application.Caller nhận được tên của đối tượng đó.
Gán toàn bộ Đối tượng với Macro SuperCall.
Đổi tên từng đối tượng sao cho tên phải khác nhau.
(đổi tên bằng Code VBA nếu cần để nhanh hơn)



Code hướng dẫn:
PHP: 
Sub SuperCall()
    If VBA.TypeName(Application.Caller) = String Then Exit Sub
    Select Case Application.Caller
    ''------------------------------
    ''Tên đối thường là:
    Case "NewShape1"
        ''Thì thực hiện
        Select Case ActiveSheet.Name
        Case "Sheet1": MsgBox "Clicked NewShape1 Sheet1"
        Case "Sheet2": MsgBox "Clicked NewShape1 Sheet2"
        Case Else:
             MsgBox "Any Sheet"
        End Select
    Case "NewShape2": Call HelloWorld_Call
    ''------------------------------
    ''Nếu tên của đối tượng cũng là tên của một thủ tục thì:
    Case Else:  Application.OnTime VBA.Now(), Application.Caller
     ''------------------------------
    End Select
End Sub

Sub SuperShape1()
    MsgBox "Clicked SuperShape1"
End Sub

Sub HelloWorld_Call()
    MsgBox "Call HelloWorld_Call"
End Sub

Sub Group1_Shape1()
    MsgBox "Call Group1_Shape1"
End Sub
---------------------


Dùng Code để gán Macro cho toàn bộ các đối tượng:
---------------------
PHP: 
Sub AssignMacroAll()
  '(BoÒ dâìu ' ðêÒ doÌng code ðýõòc thýòc hiêòn)
  On Error Resume Next
  Dim WS, O
  For Each WS In Worksheets
    ''Gán cho tâìt caÒ Shape
    ''WS.DrawingObjects.OnAction = "SuperCall"
    For Each O In WS.DrawingObjects
       ''Nêìu ðôìi týõòng có chýìa tên thiÌ gán
       ''If O.name Like "*Rectangle*" Then .OnAction = "SuperCall"

       ''Nêìu ðôìi týõòng ðaÞ ðýõòc gán Macro týÌ trýõìc ðó thiÌ gán thành SuperCall
       ''If .OnAction <> "" Then .OnAction = "SuperCall"
       ''Nêìu ðôìi týõòng ðaÞ ðýõòc gán Macro týÌ trýõìcthiÌ không làm giÌ caÒ, coÌn laòi thiÌ ...
       ''If .OnAction = "" Then
       ''   .OnAction = "..."
       ''End iF
    Next
  Next
End Sub
-------------------

Ở trên tôi đã hướng dẫn cho các bạn tạo duy nhất một Macro cho tất cả Đối tượng. Và tôi có những bài viết về VBA các bạn có thể tham khảo thêm bằng cách vào trang cá nhân của tôi trên Giải Pháp Excel này.

Chúc các bạn thành công!
Nhấp chuột vào đây để mở rộng...
Trùng hợp quá, khoảng 2 tuần trước có nghiên cứu và đã tìm ra, bây giờ lại gặp bài này. mấy hôm nay ở nhà rảnh có nghiên cứu và làm thử cái ứng dụng Quản lý quán ăn giống cái của @huuthang_bd và có dùng code click vào Shape thậm chí click phải vào Shape.
 
Upvote 0
Upvote 0
huonglien1901 đã viết:
Có share code không Anh? @giaiphap
Nhấp chuột vào đây để mở rộng...
Có chứ, nhưng hiện tại (phần cơ bản đã hoàn thành) đang chú thích code và kiểm tra lỗi. Đây là ứng dụng chỉ thực thiện theo giống như video ứng dụng của @huuthang_bd trên thực tế mình chưa áp dụng nên không biết sẽ phát sinh thêm vấn đề nào nửa hay không. Thực ra mình rất ngưỡng mộ @huuthang_bd tính xin file của anh ấy để nghiên cứu học hỏi nhưng thấy anh ấy không chia sẻ, cuối cùng ngay đợt dịch này cũng ở không nên nghiên cứu làm thử không ngờ đã thành công.
Cuối cùng mình quyết định chia sẻ cho ai có nhu cầu nghiên cứu và phát triển thêm, cũng từ ứng dụng này mình lại biết thêm nhiều thứ.
 
Upvote 0
giaiphap đã viết:
Trùng hợp quá, khoảng 2 tuần trước có nghiên cứu và đã tìm ra, bây giờ lại gặp bài này. mấy hôm nay ở nhà rảnh có nghiên cứu và làm thử cái ứng dụng Quản lý quán ăn giống cái của @huuthang_bd và có dùng code click vào Shape thậm chí click phải vào Shape.
Nhấp chuột vào đây để mở rộng...
-----------------------------

Thủ thuật trên tôi biết đã lâu, hôm nay nghĩ ai đó sẽ cần đến nên chia sẻ.


-----------------------------
Để bắt sự kiện RightClick vào một đối tượng thực hiện một tác vụ tức thì:
Chỉ có một cách duy nhất đó là sử dụng các hàm WinAPI bắt sự kiện chuột phải.

giaiphap đã viết:
nghiên cứu làm thử không ngờ đã thành công.
Nhấp chuột vào đây để mở rộng...
Bác giaiphap đừng trót đi sửa XML thay đổi Menu ngữ cảnh, hoặc Un Enable các button của Menu ngữ ảnh mặc đinh, điều đó không được gọi là sự kiện chuột phải.
Và nếu Sheet bị khóa thì điều đó vô tác dụng.
-----------------------------
Tôi giải thích cho bác về Video Trên.

Trong video Không có shape nào nhận sự kiện chuột phải cả, và Menu ngữ cảnh đã được tạo từ lớp CommandBar, khi click vào Shape thì Menu ngữ cảnh tự tạo bật lên.

-----------------------------
Để nhận sự kiện Chuột phải:
Sheet phải được khóa không cho chỉnh sửa đối tượng, để khi chuột phải vào Shape không mở Menu ngữ cảnh mặc định.
Khi Sheet được Active.
Gọi hàm SetTimer để chờ bắt sự kiện Click. Hoặc một API Hook.

Các type, lớp, hàm có thể được sử dụng như:
SetTimer
KillTimer
AccessibleObjectFromPoint
GetCursorPos
IAccessible
POINTAPI
...
 
Lần chỉnh sửa cuối:
Upvote 0
Sẵn tiện về Api ai có tài liệu tiếng việt cho mình xin để mày mò với nhé
 
Upvote 0
HeSanbi đã viết:
Chắc chắn 100% những ai đã từng gán hơn 100 macro vào Shape, label, button,.. sẽ nói "tuyệt quá, tuyệt vời quá"

Có phải bạn đang tạo một Đối tượng rồi gán một Macro vào đối tượng đó để thực hiện một tác vụ nào đó, cứ mỗi đối tượng là mỗi Macro khác nhau. Nếu như Dự án của bạn có đến Hàng trăm, có khi hàng nghìn Đối tượng cần gán Macro như vậy. Thật là vất vả phải không các bạn?
(Đối tượng bao gồm Hình ảnh, Label, Button, ...)

Bài viết này tôi sẽ hướng dẫn cho các bạn chỉ cần gán một Macro duy nhất vào tất cả các Đối tượng mà bạn cần gán vào.


Nhiều bạn học lập trình VBA có thể chưa biết khi Macro được gọi từ một Đối tượng trong trang tính Excel thì tên của Shape sẽ được trả về ngay lúc gọi là phương thức Application.Caller. Chính vì vậy mà ta có thể gán duy nhất một Macro vào tất cả các Đối tượng đó.

Hướng dẫn:
Tạo một Macro SuperCall chung cho tất cả các đối tượng mà phương thức Application.Caller nhận được tên của đối tượng đó.
Gán toàn bộ Đối tượng với Macro SuperCall.
Đổi tên từng đối tượng sao cho tên phải khác nhau.
(đổi tên bằng Code VBA nếu cần để nhanh hơn)



Code hướng dẫn:
PHP: 
Sub SuperCall()
    If VBA.TypeName(Application.Caller) = String Then Exit Sub
    Select Case Application.Caller
    ''------------------------------
    ''Tên đối thường là:
    Case "NewShape1"
        ''Thì thực hiện
        Select Case ActiveSheet.Name
        Case "Sheet1": MsgBox "Clicked NewShape1 Sheet1"
        Case "Sheet2": MsgBox "Clicked NewShape1 Sheet2"
        Case Else:
             MsgBox "Any Sheet"
        End Select
    Case "NewShape2": Call HelloWorld_Call
    ''------------------------------
    ''Nếu tên của đối tượng cũng là tên của một thủ tục thì:
    Case Else:  Application.OnTime VBA.Now(), Application.Caller
     ''------------------------------
    End Select
End Sub

Sub SuperShape1()
    MsgBox "Clicked SuperShape1"
End Sub

Sub HelloWorld_Call()
    MsgBox "Call HelloWorld_Call"
End Sub

Sub Group1_Shape1()
    MsgBox "Call Group1_Shape1"
End Sub
---------------------


Dùng Code để gán Macro cho toàn bộ các đối tượng:
---------------------
PHP: 
Sub AssignMacroAll()
  '(BoÒ dâìu ' ðêÒ doÌng code ðýõòc thýòc hiêòn)
  On Error Resume Next
  Dim WS, O
  For Each WS In Worksheets
    ''Gán cho tâìt caÒ Shape
    ''WS.DrawingObjects.OnAction = "SuperCall"
    For Each O In WS.DrawingObjects
       ''Nêìu ðôìi týõòng có chýìa tên thiÌ gán
       ''If O.name Like "*Rectangle*" Then .OnAction = "SuperCall"

       ''Nêìu ðôìi týõòng ðaÞ ðýõòc gán Macro týÌ trýõìc ðó thiÌ gán thành SuperCall
       ''If .OnAction <> "" Then .OnAction = "SuperCall"
       ''Nêìu ðôìi týõòng ðaÞ ðýõòc gán Macro týÌ trýõìcthiÌ không làm giÌ caÒ, coÌn laòi thiÌ ...
       ''If .OnAction = "" Then
       ''   .OnAction = "..."
       ''End iF
    Next
  Next
End Sub
-------------------

Ở trên tôi đã hướng dẫn cho các bạn tạo duy nhất một Macro cho tất cả Đối tượng. Và tôi có những bài viết về VBA các bạn có thể tham khảo thêm bằng cách vào trang cá nhân của tôi trên Giải Pháp Excel này.

Chúc các bạn thành công!
Nhấp chuột vào đây để mở rộng...
Phát hiện một điều không biết @HeSanbi đã thấy chưa. Lệnh Application.Caller chỉ lấy được tên đối tượng có số Ký tự dưới 31 thôi, nếu tên có số ký tự nhiều hơn 30 thì cái đoạn phía sau nó sẽ bị cắt đi. Bác @HeSanbi có cách nào hay hơn không (Ở đây không bàn đến việc đổi tên Shape nhé!).
 

File đính kèm

  • Test.xlsm
    15.6 KB · Đọc: 27
Upvote 0
giaiphap đã viết:
Phát hiện một điều không biết @HeSanbi đã thấy chưa. Lệnh Application.Caller chỉ lấy được tên đối tượng có số Ký tự dưới 31 thôi, nếu tên có số ký tự nhiều hơn 30 thì cái đoạn phía sau nó sẽ bị cắt đi. Bác @HeSanbi có cách nào hay hơn không (Ở đây không bàn đến việc đổi tên Shape nhé!).
Nhấp chuột vào đây để mở rộng...
--------------------------------

Dùng Hàm GetCursorPos lấy vị trí con trỏ chuột
Dùng phương thức RangeFromPoint để lấy đối tượng

----------------
PHP: 
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If


Sub SuperCall()
  Dim tPt As POINTAPI, Caller As String
  On Error Resume Next
  GetCursorPos tPt
  Caller = ActiveWindow.RangeFromPoint(tPt.x, tPt.y).Name
  If Caller = "" Then GoTo Ends
  MsgBox Caller
  Select Case Caller
  Case ""
  End Select
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
Kết nối vba với Database host (hiện tại đang làm host web)
Trả lời
6
Đọc
181
ongke0711
ongke0711
A
  • Question
cách dùng lockxls bảo vệ file
Trả lời
15
Đọc
3K
YêuCN
Y
S
Slicer không chuyển qua trạng thái mờ.
Trả lời
4
Đọc
83
SteveNguyen1991
S
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
2
Trả lời
29
Đọc
462
shnhatha221108
S
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3
Trả lời
54
Đọc
743
ptm0412
ptm0412
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

  • Không tìm thấy.
Back
Top Bottom