Tạo công cụ chọn ngày tháng trong USERFORM

06/07/21
Thủ thuật Excel, VBA Excel
1240
0

Hôm nay TINVANPHONG xin gửi đến các bạn đọc 1 đề tài khá quen thuộc và sử dụng rất nhiều trong lập trình VBa đó là. Tạo công cụ chọn ngày tháng trong USERFORM, đây là 1 tiện ích tối ưu hóa người dùng thân thiện quen thuộc. Nó giúp đầu vào giữ liệu luôn đúng theo khuôn mẫu đề ra.

Tạo công cụ chọn ngày tháng trong USERFORM

Tạo công cụ chọn ngày tháng trong USERFORM
Tạo công cụ chọn ngày tháng trong USERFORM

I.TỔNG QUẢN VỀ – Tạo công cụ chọn ngày tháng trong USERFORM

Đây là công cụ Lịch VBA trong Excel mà tôi đã phát triển để sử dụng với Công cụ quản lý việc cần làm của mình. Bạn có thể gắn công cụ vào một nút. Nó tạo điều kiện cho việc chọn ngày một cách trực quan.

Công cụ Lịch VBA trong Excel cũng có thể được sử dụng như một tờ lịch để điền vào các hộp văn bản ngày trong một biểu mẫu. (Đảm bảo đặt biểu mẫu đang được điền để hiển thị modal = false). Để tải xuống bản sao miễn phí của công cụ của tôi, vui lòng sử dụng nút demo bên dưới tải xuống bên dưới.

Tôi có bộ mã công cụ Lịch VBA trong Excel để điền vào ô hiện hoạt với ngày người dùng chọn. Tuy nhiên, chúng tôi có thể dễ dàng sửa đổi mã để hoạt động như một công cụ chọn lịch bật lên.

II. HƯỚNG DẪN – Tạo công cụ chọn ngày tháng trong USERFORM

BƯỚC 1: Bạn tải file DEMO phía dưới Export FILE ( Calenar ) này về , Và vào file gốc của mình Import FIle vào như hình bên dưới

Tạo công cụ chọn ngày tháng trong USERFORM
Tạo công cụ chọn ngày tháng trong USERFORM

 

Mời bạn xem qua đoạn CODE USERFORM

Option Explicit
Private Sub CmbMonth_Change()
If Me.CmbMonth.Value <> "" And Me.CmbYear.Value <> "" Then
    Call Show_Dates
    Me.lblSelectedMonth = Me.CmbMonth & "/" & Me.CmbYear
End If
End Sub
Private Sub CmbYear_Change()
    If Me.CmbMonth.Value <> "" And Me.CmbYear.Value <> "" Then
        Call Show_Dates
        Me.lblSelectedMonth = Me.CmbMonth & "/" & Me.CmbYear
    End If
End Sub
Sub ButtonClick(btn As MSForms.CommandButton)
    With btn
        If .Caption <> "" Then
            Me.TextBox1.Value = .Caption & "/" & Left(Me.CmbMonth.Value, 3) & "/" & Me.CmbYear.Value
            Unload Me
        End If
    End With
End Sub
Private Sub CommandButton1_Click()
    Call ButtonClick(Me.CommandButton1)
End Sub
Private Sub CommandButton2_Click()
    Call ButtonClick(Me.CommandButton2)
End Sub
Private Sub CommandButton3_Click()
    Call ButtonClick(Me.CommandButton3)
End Sub
Private Sub CommandButton4_Click()
    Call ButtonClick(Me.CommandButton4)
End Sub
Private Sub CommandButton5_Click()
    Call ButtonClick(Me.CommandButton5)
End Sub
Private Sub CommandButton6_Click()
    Call ButtonClick(Me.CommandButton6)
End Sub
Private Sub CommandButton7_Click()
    Call ButtonClick(Me.CommandButton7)
End Sub
Private Sub CommandButton8_Click()
    Call ButtonClick(Me.CommandButton8)
End Sub
Private Sub CommandButton9_Click()
    Call ButtonClick(Me.CommandButton9)
End Sub
Private Sub CommandButton10_Click()
    Call ButtonClick(Me.CommandButton10)
End Sub
Private Sub CommandButton11_Click()
    Call ButtonClick(Me.CommandButton11)
End Sub
Private Sub CommandButton12_Click()
    Call ButtonClick(Me.CommandButton12)
End Sub
Private Sub CommandButton13_Click()
    Call ButtonClick(Me.CommandButton13)
End Sub
Private Sub CommandButton14_Click()
    Call ButtonClick(Me.CommandButton14)
End Sub
Private Sub CommandButton15_Click()
    Call ButtonClick(Me.CommandButton15)
End Sub
Private Sub CommandButton16_Click()
    Call ButtonClick(Me.CommandButton16)
End Sub
Private Sub CommandButton17_Click()
    Call ButtonClick(Me.CommandButton17)
End Sub
Private Sub CommandButton18_Click()
    Call ButtonClick(Me.CommandButton18)
End Sub
Private Sub CommandButton19_Click()
    Call ButtonClick(Me.CommandButton19)
End Sub
Private Sub CommandButton20_Click()
    Call ButtonClick(Me.CommandButton20)
End Sub
Private Sub CommandButton21_Click()
    Call ButtonClick(Me.CommandButton21)
End Sub
Private Sub CommandButton22_Click()
    Call ButtonClick(Me.CommandButton22)
End Sub
Private Sub CommandButton23_Click()
    Call ButtonClick(Me.CommandButton23)
End Sub
Private Sub CommandButton24_Click()
    Call ButtonClick(Me.CommandButton24)
End Sub
Private Sub CommandButton25_Click()
    Call ButtonClick(Me.CommandButton25)
End Sub
Private Sub CommandButton26_Click()
    Call ButtonClick(Me.CommandButton26)
End Sub
Private Sub CommandButton27_Click()
    Call ButtonClick(Me.CommandButton27)
End Sub
Private Sub CommandButton28_Click()
    Call ButtonClick(Me.CommandButton28)
End Sub
Private Sub CommandButton29_Click()
    Call ButtonClick(Me.CommandButton29)
End Sub
Private Sub CommandButton30_Click()
    Call ButtonClick(Me.CommandButton30)
End Sub
Private Sub CommandButton31_Click()
    Call ButtonClick(Me.CommandButton31)
End Sub
Private Sub CommandButton32_Click()
    Call ButtonClick(Me.CommandButton32)
End Sub
Private Sub CommandButton33_Click()
    Call ButtonClick(Me.CommandButton33)
End Sub
Private Sub CommandButton34_Click()
    Call ButtonClick(Me.CommandButton34)
End Sub
Private Sub CommandButton35_Click()
    Call ButtonClick(Me.CommandButton35)
End Sub
Private Sub CommandButton36_Click()
    Call ButtonClick(Me.CommandButton36)
End Sub
Private Sub CommandButton37_Click()
    Call ButtonClick(Me.CommandButton37)
End Sub
Private Sub CommandButton38_Click()
    Call ButtonClick(Me.CommandButton38)
End Sub
Private Sub CommandButton39_Click()
    Call ButtonClick(Me.CommandButton39)
End Sub
Private Sub CommandButton40_Click()
    Call ButtonClick(Me.CommandButton40)
End Sub
Private Sub CommandButton41_Click()
    Call ButtonClick(Me.CommandButton41)
End Sub
Private Sub CommandButton42_Click()
    Call ButtonClick(Me.CommandButton42)
End Sub
 Private Sub img_Next_Click() 'Them 1 thang ''''''''''''''''''''''
    On Error Resume Next
    If Me.CmbMonth.ListIndex = 11 Then
        Me.CmbMonth.ListIndex = 0
        Me.CmbYear.Value = Me.CmbYear.Value + 1
    Else
        Me.CmbMonth.ListIndex = Me.CmbMonth.ListIndex + 1
    End If
End Sub
Private Sub img_previous_Click() ' Them 1 thang ''''''''''''''''''''''
    On Error Resume Next
    If Me.CmbMonth.ListIndex = 0 Then
        Me.CmbMonth.ListIndex = 11
        Me.CmbYear.Value = Me.CmbYear.Value - 1
    Else
        Me.CmbMonth.ListIndex = Me.CmbMonth.ListIndex - 1
    End If
End Sub
Private Sub UserForm_Activate()
Dim I As Integer
Dim Year_Start, Year_End As Integer
'================= Add Months to List ==============
With Me.CmbMonth
    .Clear
    For I = 1 To 12
        .AddItem VBA.Format(VBA.DateSerial(2018, I, 1), "MM")
    Next I
    .Value = VBA.Format(VBA.Date, "MM")
End With
'================ Add Years =======================
  Year_Start = VBA.Year(VBA.Date) - 5
  Year_End = VBA.Year(VBA.Date) + 5
With Me.CmbYear
    .Clear
    For I = Year_Start To Year_End
        .AddItem I
    Next I
    .Value = VBA.Format(VBA.Date, "YYYY")
End With
Call Show_Dates
If Me.TextBox1.Value <> "" Then
    Call Show_Selected_Date(CDate(Me.TextBox1.Value))
End If
End Sub
Private Sub Show_Dates()
    Dim first_Date As Date
    first_Date = VBA.DateValue("1-" & Me.CmbMonth.Value & "-" & Me.CmbYear.Value)
    Dim last_day As Integer
    last_day = VBA.Day(VBA.DateSerial(VBA.Year(first_Date), VBA.Month(first_Date) + 1, 1) - 1)
    Dim I As Integer
    Dim btn As CommandButton
    '============ Clear All button
    For I = 1 To 41
        Set btn = Me.Controls("CommandButton" & I)
        btn.Caption = ""
    Next I
    '====================
    For I = 1 To 7   'Set first date of month
        Set btn = Me.Controls("CommandButton" & I)
        If VBA.Weekday(first_Date) = I Then
            btn.Caption = "1"
        Else
            btn.Caption = ""
        End If
    Next I
    Dim btn1 As CommandButton
    Dim btn2 As CommandButton
    For I = 1 To 41
        Set btn1 = Me.Controls("CommandButton" & I)
        Set btn2 = Me.Controls("CommandButton" & I + 1)
        If btn1.Caption <> "" Then
            If last_day > btn1.Caption Then
               btn2.Caption = btn1.Caption + 1
            End If
        End If
    Next I
Call Reset_Colors
End Sub
Private Sub Reset_Colors()
Dim I As Integer
Dim btn As CommandButton
Me.img_Star.Visible = False
For I = 1 To 42
    Set btn = Me.Controls("CommandButton" & I)
    With btn
        .BackColor = &H8000000E   'set background colors
        .Enabled = True  'Enable All
        If .Caption = "" Then  'Disbale for blanks
            .Enabled = False
            .BackColor = &HE0E0E0
        End If
    End With
Next I
End Sub
 Function SelectedDate(Optional Target_Control As Object) As String
    Dim str As String
    If (TypeName(Target_Control)) = "TextBox" Or TypeName(Target_Control) = "Range" Then str = Target_Control.Value
    If (TypeName(Target_Control)) = "CommandButton" Or TypeName(Target_Control) = "Label" Then str = Target_Control.Caption
    If IsDate(str) Then
        Me.TextBox1.Value = VBA.Format(CDate(str), "DD/MM/YYYY")
        Else
        Me.TextBox1.Value = ""
    End If
    Me.sHOW
    If (TypeName(Target_Control)) = "TextBox" Or TypeName(Target_Control) = "Range" Then
         Target_Control.Value = Me.TextBox1.Value
    ElseIf (TypeName(Target_Control)) = "CommandButton" Or TypeName(Target_Control) = "Label" Then
         Target_Control.Caption = Me.TextBox1.Value
    Else
        SelectedDate = Me.TextBox1.Value
    End If
End Function
Sub Show_Selected_Date(dt As Date)
    Dim I As Integer
    Dim btn As MSForms.CommandButton
    On Error Resume Next
    Me.CmbMonth.Value = VBA.Format(dt, "MM")
    Me.CmbYear.Value = VBA.Format(dt, "YYYY")
    For I = 1 To 42
        Set btn = Me.Controls("CommandButton" & I)
        If btn.Caption = CStr(VBA.Day(dt)) Then
            Me.img_Star.Left = btn.Left + 3
            Me.img_Star.Top = btn.Top + 3
            Me.img_Star.Visible = True
            btn.BackColor = vbWhite 
        End If
    Next I
End Sub

Bước 2 : Bạn sử dụng đoạn code bên dưới để sử dụng cho textbox :

Tạo công cụ chọn ngày tháng trong USERFORM
Tạo công cụ chọn ngày tháng trong USERFORM
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call Calendar.SelectedDate(UserForm1.TextBox1)
End Sub

Sự kiện TextBox1_MouseUp : là sự một kiện liên quan đến chuột Quy trình sự kiện MouseDown hoặc MouseUp chỉ định các hành động xảy ra khi nhấn hoặc nhả nút chuột. Các sự kiện MouseDown và MouseUp cho phép bạn phân biệt giữa các nút chuột trái, phải và chuột giữa. Bạn cũng có thể viết mã cho các tổ hợp chuột-bàn phím sử dụng các công cụ sửa đổi bàn phím SHIFT, CTRL và ALT.

ByVal X As Single, ByVal Y As Single : Cần thiết. Vị trí ngang hoặc dọc, tính bằng điểm, từ cạnh trái hoặc trên cùng của biểu mẫu, Khung hoặc Trang .

Shift : Cần thiết. Trạng thái SHIFT, CTRL và ALT.

Lưu ý bạn cần chỉnh sửa UserForm1.TextBox1 để cho phù hợp

III.DOWN FILE

CLICK VÀO ĐÂY ĐÊ DOWNDEMO

Các bài có thể xem thêm

Cho phép nhập liệu số trong TEXTBOX

Tìm kiếm dữ liệu trong listbox từ textbox

Tạo phạm vi nhập liệu cho Textbox trong VBA

5/5 - (3 bình chọn)
Link Download

Link Download

Report Error Link

FanPage Facebook

Group Zalo

Share ngay

Trả lời

Email của bạn sẽ không được hiển thị công khai. Các trường bắt buộc được đánh dấu *