Tôi để màu xanh. Bạn có thể sửa tùy ý thành màu khác ở đây:
onecontrol.BackColor = RGB(0, 0, 255)
Theo tôi để tránh làm vỡ cấu trúc font chữ, thì chỉ can thiệp vào màu nền của Label. Do code trước đây tôi code thì chưa can thiệp vào màu nền Label nên xử lý khỏi mất công.
Bạn cần đăng nhập để thấy hình ảnh
1. Nội dung thay đổi:
Trên Module tôi khai báo thêm:
'http://www.ozgrid.com/forum/showthread.php?t=141695
Public myhlabel() As Clsshlabel
Public ngaylerr As Variant
Sub thietdinhngayle()
ngaylerr = Array("1/1", "9/2")
End Sub
Bạn có thêm ngày lễ theo cấu trúc
tháng/ngày. Code từ đầu tới cuối tôi theo cấu trúc tháng/ngày cho nên khỏi thắc mắc chỗ này.
Nếu bạn muốn lấy giá trị ngày/tháng thì tham khảo
Bạn cần đăng nhập để thấy link
.
Tóm lại phần khai báo ngày lễ, bạn có thể tùy ý thêm phần tử vào mảng theo cấu trúc
tháng/ngày.
Tại nơi mà bạn gọi UserForm hiện lên thì cần chạy thủ tục
thietdinhngayle.
Ở đây tôi thêm code vào sheet1:
Private Sub CommandButton1_Click()
Call thietdinhngayle 'Update 2020/04/22 Website tuhocvba.net
Calender.Show
End Sub
Cập nhật lại thủ tục
loaddayforus:
Sub loaddayforus(ByVal dtemp As Date)
Dim d As Integer 'day
Dim y As Integer 'year
Dim j As Integer
Dim m As Integer 'month
Dim day1 As Date
Dim day2 As Date
Dim temp As String
Dim nme As String 'name
Dim valn As Byte
Dim istart As Byte
Dim iend As Byte
Dim cnt As Byte
Dim onecontrol As Object
Dim nows As String
Dim nowtxt As String
'Kiem tra ngay le- website tuhocvba.net
Dim daytemp As Byte
Dim thangtemp As Byte
Dim nltemp As String 'Ex: "12/30"
y = Year(dtemp)
m = Month(dtemp)
temp = y & "/" & m & "/1"
day1 = CDate(temp)
Frame1.Caption = y & "/" & m
If m = 12 Then
y = y + 1
m = 1
Else
m = m + 1
End If
temp = y & "/" & m & "/1"
day2 = CDate(temp)
day2 = day2 - 1
istart = Weekday(day1, vbMonday)
iend = (day2 - day1) + istart
ReDim myhlabel(1 To Me.Controls.Count) As Clsshlabel
cnt = 0
nows = Now()
For Each onecontrol In Me.Controls
nme = onecontrol.Name
If InStr(1, nme, "Label_c", 1) > 0 Then
nme = Replace(nme, "Label_c", "")
valn = Val(nme)
'reset color
onecontrol.BackColor = &H8000000F
If valn >= istart And valn <= iend Then
'month
''Kiem tra ngay le - 2020/4/23 ==============
daytemp = Day(day1 + valn - istart)
thangtemp = Month(day1 + valn - istart)
'============================================
onecontrol.Caption = daytemp
onecontrol.ForeColor = &H80000012 'color black
nowtxt = Frame1.Caption & "/" & onecontrol.Caption & " "
'check today
If InStr(1, nows, nowtxt, 1) > 0 Then
onecontrol.BackColor = &HFF00FF
End If
Else
'month - 1, month + 1
''Kiem tra ngay le - 2020/4/23 ==============
daytemp = Day(day1 + valn - istart)
thangtemp = Month(day1 + valn - istart)
'============================================
onecontrol.Caption = daytemp
onecontrol.ForeColor = &H8000000A 'color gray
End If
'Kiem tra ngay le
nltemp = CStr(thangtemp) & "/" & CStr(daytemp)
For j = LBound(ngaylerr) To UBound(ngaylerr) Step 1
If InStr(1, nltemp, CStr(ngaylerr(j)), vbTextCompare) > 0 And Len(nltemp) = Len(CStr(ngaylerr(j))) Then
onecontrol.BackColor = RGB(0, 0, 255)
Exit For
End If
Next j
cnt = cnt + 1
Set myhlabel(cnt) = New Clsshlabel
Set myhlabel(cnt).hlabel = onecontrol
End If
Next
ReDim Preserve myhlabel(1 To cnt)
End Sub
Các dòng code tô màu sáng là nơi tôi đã thêm code mới vào.
2. File demo:
Bạn cần đăng nhập để thấy link
3. Điểm hạn chế: Chỉ định nghĩa được ngày nghỉ lịch dương (mùng 2 tháng 9, mùng 1 tết,...), các ngày lễ theo lịch âm thì không làm được (Ví dụ: giỗ tổ hùng vương).
Tôi cũng định bổ sung thêm lịch âm, nhưng công ty tôi chỉ dùng lịch dương, không dùng lịch âm. Nếu thêm lịch âm vào Tool, sợ rằng gây rối mắt cho người dùng, vì họ không quan tâm lịch âm.