• Class Tạo Label (Button) động trên Form (On the fly)
  • Class Tạo Label (Button) động trên Form (On the fly)

    ongke0711 > 24-05-22, 10:11 PM

    Tôi chia sẻ các bạn demo dùng Class module để tạo Label/Command button "động" trên Form.
    Khi gọi Form, tùy dữ liệu thời điểm đó để tạo ra số lượng Label tương ứng với các sự kiện (Eventprocedure) kèm theo.
    Bộ code này có thể áp dụng trong các ứng dụng quản lý số bàn trong nhà hàng, số phòng khách sạn/ nhà trọ v.v..

    Class RoomLabel:

    Mã PHP:
    Option Compare Database
    Option Explicit

    Private WithEvents mLabel As Access.Label
    Private mName As String

    Public Property Get Name() As String
      Name 
    mLabel.Name
    End Property

    Public Property Get RoomLabel() As Access.Label
      Set RoomLabel 
    mLabel
    End Property

    Public Property Set RoomLabel(TheLabel As Access.Label)
    ' On Error GoTo ErrHandler
      Set mLabel = TheLabel
      mLabel.OnClick = "[Event Procedure]"

     
      Exit Property
    ErrHandler:
      If Not (Err.Number = 459 Or Err.Number = 91) Then
          MsgBox ("Error: " & Err.Number _
                & " " & Err.Description _
                & " " & Err.Source)
      End If
      Resume Next
    End Property

    Private Sub mLabel_Click()
      '
    MsgBox "Chon phong [" mLabel.Tag "]"
      DoCmd.OpenForm "frmBooking"OpenArgs:=mLabel.Tag
    End Sub 


    Class RoomLabels (Collection)

    Mã PHP:
    Option Compare Database
    Option Explicit

    Private mRoomLabels As New Collection

    Public Function Add(TheLabel As Access.ControlctlName As String) As RoomLabel
      Dim newRoomLabel 
    As RoomLabel
      Set newRoomLabel 
    = New RoomLabel
      Set newRoomLabel
    .RoomLabel TheLabel
      mRoomLabels
    .Add newRoomLabelctlName
      Set Add 
    newRoomLabel
    End 
    Function

    Public 
    Property Get count() As Integer
      count 
    mRoomLabels.count
    End Property

    Public Property Get Item(ByVal index As Variant) As RoomLabel
      Set Item 
    mRoomLabels(index)
    End Property

    Private Sub Class_Terminate()
    Set mRoomLabels Nothing
    End Sub

    Public Sub Clear()
        Set mRoomLabels = New Collection
    End Sub

    Public Property Get Item_ByName(ByVal TheName As String) As RoomLabel
      Dim Roomlbl 
    As RoomLabel
      
    For Each Roomlbl In mRoomLabels
        
    If Roomlbl.Name TheName Then
          Set Item_ByName 
    Roomlbl
        End 
    If
      Next
    End Property 

    Link demo: https://www.mediafire.com/file/d6mqfgn6s...accdb/file