Dùng Class Module để tạo sự kiện người dùng

[anhtuan1066]

Tôi đang trong những bước đầu tiên nghiên cứu về Class Module nên sẽ viết theo sự hiểu biết của tôi. Nếu có sai sót, mong các cao thủ bổ sung thêm
Mục đích của bài viết này là:
- Tạo sự kiện người dùng khi mà các sự kiện cung cấp sẳn không đáp ứng được nhu cầu
- Khi mà chúng ta có nhu cầu "thu gom" tất cả các code của 1 số object (có cùng chức năng) về chung thành 1 code
------------------------------------------------------------------------------------------------
Giả định tình huống thế này:
- Tôi có 1 Workbook bao gồm 9 sheet, trong đó có 1 sheet Menu và 8 sheet con
- Tại sheet Menu, tôi vẽ 8 CommandButton để link đến 8 sheet con
- Tại các sheet con, mỗi sheet tôi vẽ 1 CommandButton để link đến sheet Menu
Thông thường bài toán này người ta sẽ viết cho mỗi CommandButton 1 đoạn code riêng lẻ. Như vậy, nếu số lượng object càng nhiều thì code của chúng ta sẽ trở nên dài dòng
Đàng nào thì các đoạn code ấy cũng có chung 1 mục đích... Vậy liệu có cách nào gom toàn bộ chúng thành 1 code duy nhất hay không? Câu trả lời là: Hoàn toàn có thể nếu biết dùng đến Class Module
Chúng ta cùng tiến hành giải pháp nhé
- Cứ cho rằng toàn bộ các CommandButton đã được vẽ xong
- Chuỗi mà ta gõ trên Caption của CommandButton chính là tên của sheet cần link
Vậy code của chúng ta sẽ bao gồm 2 phần
1> Trong Class Module
Hãy chèn 1 Class Module và nhớ đặt tên cho nó (trong file tôi đặt tên là MyClass) rồi đặt vào nó đoạn code này:

Public WithEvents CB As CommandButton
Private Sub CB_Click()
  On Error Resume Next
  Sheets(CB.Caption).Select
End Sub

2> Trong Module
Chèn 1 Module và đặt vào nó đoạn code này:

Public Button() As New MyClass
Sub Auto_Open()
  Dim i As Long, Obj As OLEObject, Ws As Worksheet
  For Each Ws In ThisWorkbook.Worksheets
    For Each Obj In Ws.OLEObjects
      If InStr(Obj.progID, "Forms.CommandButton") Then
        ReDim Preserve Button(i)
        Set Button(i).CB = Obj.Object
        i = i + 1
      End If
    Next Obj
  Next Ws
End Sub

Vậy là xong! Hãy chạy Autpen rồi nhấn nút thử
Nếu có ý định cho hiện 1 sheet duy nhất, các sheet khác ẩn thì sửa lại code trong Class Module như sau:

Public WithEvents CB As CommandButton
Private Sub CB_Click()
  Dim Sh As Worksheet
  On Error Resume Next
  Application.ScreenUpdating = False
  Set Sh = ActiveSheet
  Sheets(CB.Caption).Visible = True
  Sheets(CB.Caption).Select
  Sh.Visible = 2
  Application.ScreenUpdating = True
End Sub

Cũng chạy Autpen và thử bấm các nút
Điểm mấu chốt mà ta cần ghi nhớ trong toàn bộ code chỉ có 2 đoạn:
Public WithEvents CB As CommandButton (Khai báo)
và
Set Button(i).CB = Obj.Object (thiết lập để chúng "bắt tay" nhau)
Không có chúng thì toàn bộ sẽ "tan rã"
------------------------------------------------------------------------------------------------
Tóm lại công việc của chúng ta chỉ là:
- Đặt 2 đoạn code vào đúng vị trí
- Đặt tên cho Class Module
- Vẽ các CommandButton và gõ tên sheet cần link vào caption của chúng
- Chạy Autpen để khởi động việc "thu gom"
Điểm thú vị ở đây là:
- Chỉ có các CommandButton (thuộc ActiveX Control) mới bị ảnh hưởng bởi code này (các object khác hoàn toàn không bị ảnh hưởng)
- Với các CommandButton, chỉ cái nào có caption là tên sheet mới bị ảnh hưởng bởi code này
------------------------------------------------------------------------------------------------
Xin lưu ý với các bạn rằng:
- Việc dùng CommandButton để link với các sheet không phải là mục đích chính của bài viết này (chỉ lấy ví dụ để minh họa), vì thế mà tôi đã không đặt nó vào chung với topic: Tạo nút nhấn để link đến các sheet
- Mục đích chính của bài viết này là hướng dẩn cách dùng Class Module để tự tạo 1 sự kiện người dùng
- Code này chỉ thuộc dạng cơ bản, có thể tùy biến đề áp dụng cho rất nhiều bài toán khác
------------------------------------------------------------------------------------------------
Chỉ với 1 bài viết thì chưa đủ để nói về EventClass, vậy nên rất mong các cao thủ khác cùng góp sức hoàn thiện bài viết này

 

[ndu96081631]

Còn khi nhấn vào No Color thì Sample im re luôn. Có MouseMove cũng không được nữa. Vậy phải khắc phục sao nhỉ?
hân.

Trong Class Moduel có đoạn:

Private Sub CB_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If CB.Caption = "No Color" Then Exit Sub
    If MyFrm.Sample.BackColor <> CB.BackColor Then
        MyFrm.Sample.BackColor = CB.BackColor
        If Not MyFrm.IsOk Then Selection.Interior.Color = CB.BackColor
    End If
End Sub

Sửa thành vầy là được:

Private Sub CB_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If CB.Caption = "No Color" Then Exit Sub
    If MyFrm.Sample.BackColor <> CB.BackColor Then
        MyFrm.Sample.BackColor = CB.BackColor
        [COLOR=Red][B]MyFrm.Sample.BackStyle = 1[/B][/COLOR]
        If Not MyFrm.IsOk Then Selection.Interior.Color = CB.BackColor
    End If
End Sub

 

[Po_Pikachu]

Tải lại xem nha!
ColorPicker.rar
Em chỉnh hơi bị nhiều nên cũng không biết nói sao nữa.
Thân.

 

[Nguyễn Duy Tuân]

Tải lại xem nha!
ColorPicker.rar
Em chỉnh hơi bị nhiều nên cũng không biết nói sao nữa.
Thân.

Bạn muốn làm điều gì sao lại phá tan file ColorPicker của tôi đã làm?

 

[Po_Pikachu]

Xin lỗi bác nha. Em không cố ý làm bác giận đâu.
Chỉ là em thấy chỉ cần như vậy là chạy được theo yêu cầu rùi.
Méo mó nghề nghiệp tý thui. hihi
Bác đừng giận nha!
Thân.

 

[Nguyễn Duy Tuân]

Xin lỗi bác nha. Em không cố ý làm bác giận đâu.
Chỉ là em thấy chỉ cần như vậy là chạy được theo yêu cầu rùi.
Méo mó nghề nghiệp tý thui. hihi
Bác đừng giận nha!
Thân.

Thấy bạn bỏ code vô lý quá. Code tôi viết trong ColorPicker là không thừa không thiếu đâu bạn ạ. Nó làm theo các yêu cầu dưới đây:

...tôi nâng cấp thêm như sau:
+ Khi mở form, tự nhận màu trong vùng lựa chọn cho nút bấm và cửa sổ "Sample"
+ Khi di chuột trên các nút màu, vùng lựa chọn và cửa sổ Sample tạm nhận màu luôn. Chỉ nhận chính thức khi nhấn chuột vào nút đó, giống như Office 2007.
+ Code trong Class sửa lại để phù hợp với nâng cấp.

Thêm nữa là bấm vào nút chọn màu là thoát form luôn và xác lập nhận màu (IsOk = True), nếu bấm vào nút "Exit" hoặc dấu (X) là thoát và khôi phục lại mầu trước khi mở form.

Nếu bạn có ý tưởng nào khác thì có thể làm mẫu một file khác gửi lên tôi sẽ tìm giải pháp cùng bạn.

 

[ndu96081631]

Tải lại xem nha!
ColorPicker.rar
Em chỉnh hơi bị nhiều nên cũng không biết nói sao nữa.
Thân.

Code này vẫn còn lỗi ---> Khi bấm nút "No Color" thì nó hết tô màu cho cell luôn!
----------------------
Xin lỗi Tuân trước, mình thấy cách viết code của Tuân là cách viết chuyên nghiệp... chính thế mà những người không chuyên như mình rất khó theo kịp
Chẳng trách gì Po lại "phá" tùm lum ---> Mục đích cũng là tìm ra "chân lý" từ những cái đơn giản trước
----------------------

...tôi nâng cấp thêm như sau:
+ Khi mở form, tự nhận màu trong vùng lựa chọn cho nút bấm và cửa sổ "Sample"
+ Khi di chuột trên các nút màu, vùng lựa chọn và cửa sổ Sample tạm nhận màu luôn. Chỉ nhận chính thức khi nhấn chuột vào nút đó, giống như Office 2007.
+ Code trong Class sửa lại để phù hợp với nâng cấp..

Bây giờ mới hiểu tính phức tạp của vấn đề đây!
Cảm ơn bạn!

 

[anhtuan1066]

Cải tiến file ColorPicker

Nhân dịp bạn Nguyễn Duy Tuân nâng cấp file ColorPicker, tôi muốn làm thêm 1 số cải tiến nữa:
- Có khả năng hoạt động với vùng dữ liệu không liên tục
- Có khả năng nhận biết được nhiều màu sắc có trong 1 vùng
---------------
Xin mời xem file! Ưu điểm của nó là code ngắn gọn
---------------
Ngoài ra, các bạn nhớ nghiên cứu bài số #5 và gữi lên đây nhé

 

[Nguyễn Duy Tuân]

Nhân dịp bạn Nguyễn Duy Tuân nâng cấp file ColorPicker, tôi muốn làm thêm 1 số cải tiến nữa:
- Có khả năng hoạt động với vùng dữ liệu không liên tục
- Có khả năng nhận biết được nhiều màu sắc có trong 1 vùng
---------------
Xin mời xem file! Ưu điểm của nó là code ngắn gọn
---------------
Ngoài ra, các bạn nhớ nghiên cứu bài số #5 và gữi lên đây nhé

Anh Tuấn ơi, trong file anh sử dụng thư viện "Office Web component". Một số máy không cài nên lỗi ở đối tượng Spreadsheat1. Anh có thể dùng biến mảng để ghi lại màu.

 

[anhtuan1066]

Anh Tuấn ơi, trong file anh sử dụng thư viện "Office Web component". Một số máy không cài nên lỗi ở đối tượng Spreadsheat1. Anh có thể dùng biến mảng để ghi lại màu.

Vâng! Lúc đầu tôi cũng định vậy, nhưng chợt phát hiện ra trong VBA có đối tượng SpreadSheet, tại sao ta không dùng nhỉ?
Chỉ thêm có 1 đối tượng mà đã khiến cho code ngắn gọn và linh hoạt tuyệt vời rồi! Khi ta chọn vùng không liên tục mà đưa chúng vào mảng là khá nhiêu khê đấy
Mà việc cài thêm nó hầu như không gây khó khăn gì (nếu không nói là hầu hết các máy đều có sẳn khi cài Office)

 

[sealand]

Tôi ưng cái Class này cho việc của mình quá, nó thật hiệu quả, khoa học và gọn gàng. nhưng khi chuyển từ Module sang Class không được.

Yêu cầu là:
Trên 1 Form có 8 TextBox, không có Label:
-Khi TextBox nhận Focus thì: Hiện lời nhắc thay Label nếu TextBox trống. Nền vàng, Chữ đỏ.
-Khi TextBox mất Focus thì: Nếu Nội dung là lời nhắc thì xoá. Nền xanh nhạt, chữ xanh dương.

Trong File None Class là cơ bản kết quả
Trong file Class là mình đã chuyển sang Class nhưng không thành công. (Dùng sự kiện Enter và Exit tương tự như TextBox với Module)
Nhờ anh em hướng dẫn giùm.
Mình muốn gửi bài này vào đây chứ không mở bài riêng vì thực chất đây cũng là ví dụ rất cụ thể cho bài này và vận dụng cơ bản lý thuyết bài này.

 

[ndu96081631]

Tôi ưng cái Class này cho việc của mình quá, nó thật hiệu quả, khoa học và gọn gàng. nhưng khi chuyển từ Module sang Class không được.

Yêu cầu là:
Trên 1 Form có 8 TextBox, không có Label:
-Khi TextBox nhận Focus thì: Hiện lời nhắc thay Label nếu TextBox trống. Nền vàng, Chữ đỏ.
-Khi TextBox mất Focus thì: Nếu Nội dung là lời nhắc thì xoá. Nền xanh nhạt, chữ xanh dương.

Trong File None Class là cơ bản kết quả
Trong file Class là mình đã chuyển sang Class nhưng không thành công. (Dùng sự kiện Enter và Exit tương tự như TextBox với Module)
Nhờ anh em hướng dẫn giùm.
Mình muốn gửi bài này vào đây chứ không mở bài riêng vì thực chất đây cũng là ví dụ rất cụ thể cho bài này và vận dụng cơ bản lý thuyết bài này.

Em sửa lại vầy:
- Đầu tiên em cho mấy thông tin trong Info vào trong Tag
- Code sửa lại như sau:
1> Trong UserForm

Dim dkhien() As New Sea
Private Sub UserForm_Initialize()
  Dim Ctrl As Control, i
  For Each Ctrl In Me.Controls
    If TypeOf Ctrl Is MSForms.TextBox Then
      Ctrl.ForeColor = &HFF0000
      Ctrl.BackColor = &HFFFFC0
      ReDim Preserve dkhien(i)
      Set dkhien(i).DK = Ctrl
      i = i + 1
    End If
  Next
End Sub

2> Trong Class Module

Public WithEvents DK As MSForms.TextBox
Private Sub DK_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim tb As MSForms.Control
  For Each tb In UserForm1.Controls
    If TypeOf tb Is MSForms.TextBox Then
      If tb <> DK Then
      tb.ForeColor = &HFF0000
      tb.BackColor = &HFFFFC0
      If tb.Text = tb.Tag Then tb.Text = ""
      End If
    End If
  Next
  DK.ForeColor = &HFF&
  DK.BackColor = &HC0FFFF
  If DK.Text = "" Then
    DK.Text = DK.Tag
    DK.SelStart = 0
    DK.SelLength = Len(DK.Text)
  End If
End Sub

Khai báo kiểu Public WithEvents DK As MSForms.TextBox thì DK sẽ không có sự kiện Enter và Exit đâu anh à!
Code này chỉ có tác dụng khi anh dùng chuột chọn vào TextBox ---> Để có thể xài luôn được với phím Enter và phím Tab, anh cho nguyên code trên vào sự kiện DK_KeyUp nữa là ăn tiền

 

[ndu96081631]

Rút gọn code

Em rút gọn code trong Class Module thế này:

Public WithEvents DK As MSForms.TextBox

Private Sub DK_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  ObjColor DK
End Sub

Private Sub DK_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ObjColor DK
End Sub

Private Sub ObjColor(Mytb As MSForms.TextBox)
  Dim tb As MSForms.Control
  For Each tb In UserForm1.Controls
    If TypeOf tb Is MSForms.TextBox Then
      tb.ForeColor = &HFF0000
      tb.BackColor = &HFFFFC0
      If tb.Text = tb.Tag Then tb.Text = ""
    End If
  Next
  Mytb.ForeColor = &HFF&
  Mytb.BackColor = &HC0FFFF
  If Mytb.Text = "" Then
    Mytb.Text = DK.Tag
    Mytb.SelStart = 0
    Mytb.SelLength = Len(Mytb.Text)
  End If
End Sub

anh kiểm tra xem có chổ nào không ổn giúp em với

 

[sealand]

Quá hay, riêng Form này bỏ đi gần 20 cái Sub. Chỉ còn một điều là khi thoát TextBox cuối nó chưa reset lại nó là có thể áp dụng cho các Form. Quan sát thấy Form thân thiện và Pro hơn.
Từ đây cũng có điều rút ra là kiểm tra Class có thể có 2 trường hợp sau:

-Không phải Class hỗ trợ tất cả các Event, Property, Method mà đối tượng có.
-Chưa tìm ra cách sử dung nó.
​

Mong anh em có khả năng chỉ dẫn giùm.

 

[ndu96081631]

Em chưa hiểu câu này anh ơi:

Chỉ còn một điều là khi thoát TextBox cuối nó chưa reset lại nó là có thể áp dụng cho các Form.

 

[sealand]

Tức là khi con trỏ rời TextBox8 sang nút Exit thì TextBox8 vẫn còn nguyên nền vàng và lời nhắc. Đáng lẽ không nhập gì thì nó bị xoá và chuyển về nền xanh nhạt và chữ xanh dương.
Lưu ý: TextBox1 (Khi lùi) và TextBox8(Khi tiến) Focus sang đối tượng khác loại nên không gọi Class

 

[ndu96081631]

Tức là khi con trỏ rời TextBox8 sang nút Exit thì TextBox8 vẫn còn nguyên nền vàng và lời nhắc. Đáng lẽ không nhập gì thì nó bị xoá và chuyển về nền xanh nhạt và chữ xanh dương.
Lưu ý: TextBox1 (Khi lùi) và TextBox8(Khi tiến) Focus sang đối tượng khác loại nên không gọi Class

Để viết thêm cái này chắc không khó... nhưng e rằng hơi mất công!
Anh thí nghiệm xem

Lưu ý: TextBox1 (Khi lùi) và TextBox8(Khi tiến) Focus sang đối tượng khác loại nên không gọi Class

Muốn vậy anh phải viết thêm code cho các đối tượng khác nữa thì mới xong!

 

[sealand]

Mình nêu lên vậy nếu sử lý được trong Class thì tốt còn không thì tạm gài vào đối tượng có TabStop=Tabstop cua Text box8 +1 cũng ổn.

 

[ndu96081631]

Mình nêu lên vậy nếu sử lý được trong Class thì tốt còn không thì tạm gài vào đối tượng có TabStop=Tabstop cua Text box8 +1 cũng ổn.

Anh có thể thiết lập TabStop của những Control khác = FALSE là được rồi

 

[anhtuan1066]

File tham khảo cho bài #5

Về câu hỏi tại bài số #5 tôi xin gữi 1 code tham khảo
1> Trong Module

Public Button() As New MyClass
Public CB As ComboBox
Sub Auto_Open()
  Dim Obj As OLEObject, i As Long
  For Each Obj In Sheet1.OLEObjects
    If InStr(Obj.progID, "Forms.ComboBox") Then
      ReDim Preserve Button(i)
      Set Button(i).cbBox = Obj.Object
      i = i + 1
    End If
  Next
End Sub

2> Trong Class Module

Public WithEvents cbBox As ComboBox
Private Sub cbBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Set CB = cbBox
End Sub

Xin mời xem file và cải tiến tiếp nếu có thể được
Tôi vẫn chưa nghĩ ra cách viết code trong trường hợp Object là TextBox (chứ không phải ComboBox)...
Các bạn thử nghiên cứu xem

 

[minhcong.tckt]

Tôi đang trong những bước đầu tiên nghiên cứu về Class Module nên sẽ viết theo sự hiểu biết của tôi. Nếu có sai sót, mong các cao thủ bổ sung thêm
Mục đích của bài viết này là:
- Tạo sự kiện người dùng khi mà các sự kiện cung cấp sẳn không đáp ứng được nhu cầu
- Khi mà chúng ta có nhu cầu "thu gom" tất cả các code của 1 số object (có cùng chức năng) về chung thành 1 code
------------------------------------------------------------------------------------------------
Giả định tình huống thế này:
- Tôi có 1 Workbook bao gồm 9 sheet, trong đó có 1 sheet Menu và 8 sheet con
- Tại sheet Menu, tôi vẽ 8 CommandButton để link đến 8 sheet con
- Tại các sheet con, mỗi sheet tôi vẽ 1 CommandButton để link đến sheet Menu
Thông thường bài toán này người ta sẽ viết cho mỗi CommandButton 1 đoạn code riêng lẻ. Như vậy, nếu số lượng object càng nhiều thì code của chúng ta sẽ trở nên dài dòng
Đàng nào thì các đoạn code ấy cũng có chung 1 mục đích... Vậy liệu có cách nào gom toàn bộ chúng thành 1 code duy nhất hay không? Câu trả lời là: Hoàn toàn có thể nếu biết dùng đến Class Module
Chúng ta cùng tiến hành giải pháp nhé
- Cứ cho rằng toàn bộ các CommandButton đã được vẽ xong
- Chuỗi mà ta gõ trên Caption của CommandButton chính là tên của sheet cần link
Vậy code của chúng ta sẽ bao gồm 2 phần
1> Trong Class Module
Hãy chèn 1 Class Module và nhớ đặt tên cho nó (trong file tôi đặt tên là MyClass) rồi đặt vào nó đoạn code này:

Public WithEvents CB As CommandButton
Private Sub CB_Click()
  On Error Resume Next
  Sheets(CB.Caption).Select
End Sub

2> Trong Module
Chèn 1 Module và đặt vào nó đoạn code này:

Public Button() As New MyClass
Sub Auto_Open()
  Dim i As Long, Obj As OLEObject, Ws As Worksheet
  For Each Ws In ThisWorkbook.Worksheets
    For Each Obj In Ws.OLEObjects
      If InStr(Obj.progID, "Forms.CommandButton") Then
        ReDim Preserve Button(i)
        Set Button(i).CB = Obj.Object
        i = i + 1
      End If
    Next Obj
  Next Ws
End Sub

Vậy là xong! Hãy chạy Autpen rồi nhấn nút thử
Nếu có ý định cho hiện 1 sheet duy nhất, các sheet khác ẩn thì sửa lại code trong Class Module như sau:

Public WithEvents CB As CommandButton
Private Sub CB_Click()
  Dim Sh As Worksheet
  On Error Resume Next
  Application.ScreenUpdating = False
  Set Sh = ActiveSheet
  Sheets(CB.Caption).Visible = True
  Sheets(CB.Caption).Select
  Sh.Visible = 2
  Application.ScreenUpdating = True
End Sub

Cũng chạy Autpen và thử bấm các nút
Điểm mấu chốt mà ta cần ghi nhớ trong toàn bộ code chỉ có 2 đoạn:
Public WithEvents CB As CommandButton (Khai báo)
và
Set Button(i).CB = Obj.Object (thiết lập để chúng "bắt tay" nhau)
Không có chúng thì toàn bộ sẽ "tan rã"
------------------------------------------------------------------------------------------------
Tóm lại công việc của chúng ta chỉ là:
- Đặt 2 đoạn code vào đúng vị trí
- Đặt tên cho Class Module
- Vẽ các CommandButton và gõ tên sheet cần link vào caption của chúng
- Chạy Autpen để khởi động việc "thu gom"
Điểm thú vị ở đây là:
- Chỉ có các CommandButton (thuộc ActiveX Control) mới bị ảnh hưởng bởi code này (các object khác hoàn toàn không bị ảnh hưởng)
- Với các CommandButton, chỉ cái nào có caption là tên sheet mới bị ảnh hưởng bởi code này
------------------------------------------------------------------------------------------------
Xin lưu ý với các bạn rằng:
- Việc dùng CommandButton để link với các sheet không phải là mục đích chính của bài viết này (chỉ lấy ví dụ để minh họa), vì thế mà tôi đã không đặt nó vào chung với topic: Tạo nút nhấn để link đến các sheet
- Mục đích chính của bài viết này là hướng dẩn cách dùng Class Module để tự tạo 1 sự kiện người dùng
- Code này chỉ thuộc dạng cơ bản, có thể tùy biến đề áp dụng cho rất nhiều bài toán khác
------------------------------------------------------------------------------------------------
Chỉ với 1 bài viết thì chưa đủ để nói về EventClass, vậy nên rất mong các cao thủ khác cùng góp sức hoàn thiện bài viết này

Em làm đúng như bác nói,nhưng nó báo lỗi: Compile error
invalid use of ..keyword

Mong sự giúp đỡ