Class module - Kỹ thuật Tạo và Wrap đối lượng

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia ngày
13 Tháng sáu 2006
Bài viết
4,224
Được thích
9,729
Điểm
860
Nơi ở
Hà Nội
Class module là một kỹ thuật nâng cao để người phát triển tạo thêm cho mình những class/đối tượng hay "bao" một đối tượng.
Có 2 lý do sau buộc bạn phải viết class:
+ Tạo đối tượng giống nhau.
+ Gán thêm thuộc tính cho một control/đối tượng đã có (như là: Property, Method, Even).

Xem file đính kèm dưới đây các bạn sẽ hiểu thêm ý nghĩa của nó.

(Để học cách viết code trong Class module, các bạn hãy tìm các bài viết đã có trên diễn đàn này hoặc tìm đọc tài liệu lập trình Class trong VB/VBA trên mạng)
 

File đính kèm

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia ngày
13 Tháng sáu 2006
Bài viết
4,224
Được thích
9,729
Điểm
860
Nơi ở
Hà Nội
Kiểm soát nhập liệu trong Excel

Gửi các bạn một ví dụ về cách quản lý tất cả quá trình hoạt động của Excel.
 

File đính kèm

Lần chỉnh sửa cuối:

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia ngày
13 Tháng sáu 2006
Bài viết
4,224
Được thích
9,729
Điểm
860
Nơi ở
Hà Nội
clsCommandButton

Nhân có ngươì bạn nhờ giúp về kỹ thuật CommandButton, tôi làm một ví dụ về kỹ thuật tạo và bao/Wrapping đối tượng CommandButton. Với file ví dụ "clsCommandButton.xls" chắc các bạn sẽ rất thú vị! Mong rằng sau này chúng ta sẽ có nhiều người coding nhiều với "Class module".

B1) Tạo một module (Trong VBE, vào menu Insert->Module) để test
Mã:
Option Explicit
'-------------------------------------------------
Const strClassObj As String = "Forms.CommandButton.1"
Public ctrlShNum() As clsCommandButton
Private CtrlCount As Integer
Public oldBtn As String
'-------------------------------------------------
Sub CreateCommandButtonOnSheet()
On Error GoTo Done

Dim cell As Range, objRanges As Range
Dim sh As Worksheet
Dim obj As OLEObject
Dim oldEvent As Boolean

oldEvent = Application.EnableEvents
Application.EnableEvents = False

    Set sh = ActiveSheet
    Set objRanges = Range("B3:B14")
    objRanges.RowHeight = 24
    
    CtrlCount = -1
    For Each cell In objRanges
        Set obj = sh.OLEObjects.Add(ClassType:=strClassObj, _
        Link:=False, DisplayAsIcon:=False, Left:=cell.Left, Top:=cell.Top, _
        Width:=cell.Width, Height:=cell.Height)
     
        CtrlCount = CtrlCount + 1
        ReDim Preserve ctrlShNum(CtrlCount) As clsCommandButton
        Set ctrlShNum(CtrlCount) = New clsCommandButton
        
        With ctrlShNum(CtrlCount)
            .Wrap obj.Object  
            .Caption = "CommandButton " & CtrlCount
        End With
        Set obj = Nothing
        Set cell = Nothing
    Next
Done:

Application.EnableEvents = oldEvent
    
    Set objRanges = Nothing
    Set sh = Nothing
If Err.Number <> 0 Then MsgBox Err.Description
End Sub
'-------------------------------------------------
Sub DeleteAllCommandButtons()
On Error Resume Next

Dim sh As Worksheet
Dim obj As OLEObject
Dim i As Integer
    Set sh = ActiveSheet
    For Each obj In sh.OLEObjects
        If obj.progID = strClassObj Then
            obj.Delete
        End If
    Next
    
    For i = LBound(ctrlShNum, 1) To UBound(ctrlShNum, 1)
        If Not ctrlShNum(i) Is Nothing Then
            Set ctrlShNum(i) = Nothing
        End If
    Next
    ReDim ctrlShNum(0) As clsCommandButton
    Set sh = Nothing

End Sub
B2) Tạo một Class/đối tượng (Trong VBE, vào menu Insert->Class module) , đặt tên là "clsCommandButton"

Mã:
'**************************************************************
Option Explicit
Private WithEvents ctrl As MSForms.CommandButton

'Constructor
Private Sub Class_Initialize()
    
End Sub

'FreeMem/Dispose
Private Sub Class_Terminate()
    If Not ctrl Is Nothing Then
        'ctrl.Delete
        Set ctrl = Nothing
    End If
End Sub
'-------------------------------------------------
'Methods
Public Sub Add(Form As MSForms.UserForm, Optional ByVal strCaption As String = "")
    Set ctrl = Form.Controls.Add("Forms.CommandButton.1")
    If strCaption <> "" Then
        ctrl.Caption = strCaption
    End If
End Sub
'-------------------------------------------------
Public Sub Wrap(ByVal ctrlCoomandButton As Object, Optional ByVal strCaption As String = "")
    Set ctrl = ctrlCoomandButton
    If strCaption <> "" Then
        ctrl.Caption = strCaption
    End If
End Sub
'-------------------------------------------------
'Properties

'Property Value
'-------------------------------------------------
Public Property Let Caption(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
    ctrl.Caption = vData
End Property
Public Property Get Caption() As String
'used when retrieving value of a property, on the right side of an assignment.
    Caption = ctrl.Caption
End Property
'-------------------------------------------------
Public Property Let ForeColor(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
    ctrl.ForeColor = vData
End Property
Public Property Get ForeColor() As Long
'used when retrieving value of a property, on the right side of an assignment.
    ForeColor = ctrl.ForeColor
End Property
'-------------------------------------------------
Public Property Let BackColor(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
    ctrl.BackColor = vData
End Property
Public Property Get BackColor() As Long
'used when retrieving value of a property, on the right side of an assignment.
    BackColor = ctrl.BackColor
End Property
'-------------------------------------------------
'Property Top
Public Property Let Top(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
    ctrl.Top = vData
End Property
Public Property Get Top() As Integer
'used when retrieving value of a property, on the right side of an assignment.
    Top = ctrl.Top
End Property
'-------------------------------------------------
'Property Left
Public Property Let Left(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
    ctrl.Left = vData
End Property
Public Property Get Left() As Integer
'used when retrieving value of a property, on the right side of an assignment.
    Left = ctrl.Left
End Property
'-------------------------------------------------
'Property Width
Public Property Let Width(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
    ctrl.Width = vData
End Property
Public Property Get Width() As Integer
'used when retrieving value of a property, on the right side of an assignment.
    Width = ctrl.Width
End Property
'-------------------------------------------------
'Property Height
Public Property Let Height(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
    ctrl.Height = vData
End Property
Public Property Get Height() As Integer
'used when retrieving value of a property, on the right side of an assignment.
    Height = ctrl.Height
End Property
'-------------------------------------------------

[COLOR="Green"]'Events[/COLOR]
Private Sub ctrl_Click()
    ctrl.ForeColor = vbBlue
    MsgBox ctrl.Caption, , oldBtn
End Sub
'-------------------------------------------------
Private Sub ctrl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim objCtrl As MSForms.CommandButton
    If oldBtn <> ctrl.Name Then
    '--Reset
        If oldBtn <> "" Then
            If TypeName(ctrl.Parent) = "Worksheet" Then '// Parent is Worksheet
                Set objCtrl = ctrl.Parent.OLEObjects(oldBtn).Object
            Else '// Parent is Userform
                Set objCtrl = ctrl.Parent.Controls(oldBtn)
            End If
            
            With objCtrl
                .ForeColor = vbBlack
                .BackColor = vb3DFace
                .Font.Bold = False
            End With
        End If
    '--Set New
        oldBtn = ctrl.Name
        ctrl.ForeColor = vbRed
        ctrl.Font.Bold = True
        ctrl.BackColor = vbYellow
    End If
End Sub
Các bạn tải file đính kèm tham khảo.
 

File đính kèm

Lần chỉnh sửa cuối:

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia ngày
13 Tháng sáu 2006
Bài viết
4,224
Được thích
9,729
Điểm
860
Nơi ở
Hà Nội
Không cho đóng và lưu các workbook đang mở!

Xin gửi thêm các bạn ví dụ về khóa tất cả các workbook đang mở. Chương trình rất dễ viết nhưng phải dùng Class Module.

Bước 1: Tạo Class Module, đặt tên là clsExcelApp.
Trong môi trường VBA/VBE, Vào menu Insert\Class Module. Đặt tên class là clsExcelApp.

Soạn các lệnh sau vào trong class clsExcelApp.
Mã:
Option Explicit

Private WithEvents MyExcelApp As Excel.Application
Private mCancelClose As Boolean
Private mCancelSave As Boolean

Private Sub Class_Initialize()
    
End Sub

Private Sub Class_Terminate()
    Destroy
End Sub

Public Sub Create(ByVal ExcelApplication As Excel.Application)
    If Not MyExcelApp Is Nothing Then Exit Sub
    Set MyExcelApp = ExcelApplication
End Sub

Public Sub Destroy()
    Set MyExcelApp = Nothing
End Sub

Private Sub MyExcelApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    Cancel = mCancelClose
    If Cancel Then
        MsgBox "All workbook are locked!. To unlock them, you send bears to me now!", vbCritical, "Author: Nguyen Duy Tuan"
    End If
End Sub

Public Property Get CancelClose() As Boolean
    CancelClose = mCancelClose
End Property

Public Property Let CancelClose(ByVal bNewValue As Boolean)
    mCancelClose = bNewValue
End Property

Public Property Get CancelSave() As Boolean
    CancelSave = mCancelSave
End Property

Public Property Let CancelSave(ByVal bNewValue As Boolean)
    mCancelSave = bNewValue
End Property

Private Sub MyExcelApp_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = mCancelSave
    SaveAsUI = Not Cancel
    If Cancel Then
        MsgBox """" & Wb.Name & """ can not save. You send bears to me for saving!", vbCritical, "Author: Nguyen Duy Tuan"
    End If
End Sub
Bước 2: Tạo Module để tạo các thủ tục chạy
Trong môi trường VBA/VBE, Vào menu Insert\Module.

Soạn các lệnh sau vào trong module
Mã:
Option Explicit
Dim MyExcelApp As clsExcelApp
Sub LockAllWorkbook()
    
    If Not MyExcelApp Is Nothing Then Exit Sub
    
    Set MyExcelApp = New clsExcelApp
    With MyExcelApp
        .Create Application
        .CancelClose = True
        .CancelSave = True
    End With
    
    MsgBox "All workbook are locked from this time!" & Chr(13) & _
            "To unlock, click ""StopLock"" button.", vbExclamation
    
End Sub

Sub CancelLoking()
    If MyExcelApp Is Nothing Then Exit Sub
    MyExcelApp.CancelClose = False
    MyExcelApp.CancelSave = False
End Sub

Sub StopLock()
    Set MyExcelApp = Nothing
    MsgBox "All workbook are free (unlock)!", vbInformation
End Sub
Toàn bộ mã nguồn có trong file đính kèm.
 

File đính kèm

Lần chỉnh sửa cuối:

thaiphongnet

Thành viên mới
Tham gia ngày
12 Tháng mười 2019
Bài viết
2
Được thích
0
Điểm
13
Tuổi
35
Nơi ở
TPHCM
Mình tải file của bạn về mở chỉ xuất hiện một hộp thoại à
 

tonybinh

Thành viên mới
Tham gia ngày
24 Tháng tư 2009
Bài viết
1
Được thích
0
Điểm
663
Tuổi
31
Mình đang tìm tòi học hỏi về VBA này, mình thấy khi tạo CommandButtons hơn 15 cái thì UserForm không độ dài.Minh có cách làm làm 1 cái Scroll để thấy được những
CommandButtons bị quá size UserForm không ạ? Xin Anh/Chị/Em trong nhóm hỗ trợ giúp ! Cám ơn nhiều ạ
 

File đính kèm

Top Bottom