Chia sẻ calendar

tuhocvba

Administrator
Thành viên BQT
Bạn cần đăng nhập để thấy hình ảnh
Mới đây Excel đã cập nhật Calendar trong thư viện UserForm. Tuy nhiên điều đó cũng có nghĩa là nếu người dùng sử dụng office 2003 hoặc cũ hơn thì không thể sử dụng được.
Với cách nghĩ bất cứ ai cũng dùng được, hoặc ít nhất thì cũng là càng nhiều người có khả năng dùng được thì càng tốt, cho nên mình đã tạo ra calendar này.
Các bạn có thể trích xuất để cho vào file của các bạn.
Ứng dụng của nó. Bất cứ ứng dụng nào sử dụng ngày tháng, bạn đều có thể nhúng mã nguồn này vào để sử dụng. Sẽ rất cool so với việc hiện danh sách ngày tháng thành list ở combobox đấy.

Link download:
Mã:
http://www.mediafire.com/file/ub2b1na2usgg95b/calender_class.xlsm/file
 
T

thanhphuongvip

Guest
Bạn có thể chỉ mình để khi mình click vào textbox chọn Ngày tháng, thì nó sẽ hiển thị lịch, và khi mình chọn 1 ngày thì ngày đó sẽ đc đưa vào textbox đó đc ko, ví dụ như hình:

Bạn cần đăng nhập để thấy hình ảnh


Trong hình trên thường mình phải nhập thủ công vào mục Ngày.
Xin đa tạ!!
 

tuhocvba

Administrator
Thành viên BQT
Step 1:
Bạn xuất userform, module, class trên file excel calendar đó ra theo hướng dẫn như trong video dưới đây.
Hoặc bạn có thể download ở đây, mình đã xuất ra sẵn cho bạn rồi.
Link download :
Step 2:
Bạn import chúng vào file excel của bạn như hướng dẫn trong video dưới đây.
Step 3:
Click đúp vào ô text box của bạn. Chọn sự kiện click. Làm như hướng dẫn trong video.
Viết vào nội dung hàm, dòng code sau:
Mã:
Calender.Show
Step 4: Vào class tìm dòng code:
Mã:
MsgBox temp
Sửa thành:
Mã:
TenUserFormcủabạn.Tên ô textboxcủabạn.Text = temp
Calender.Hide
Bạn cần đăng nhập để thấy đa phương tiện
 
T

thanhphuongvip

Guest
Cho mình hỏi thêm xíu:
Là chỗ này mình viết lệnh để ngày tháng đc nhập vào Textbox, nhưng giả sử trong phần mềm của chúng ta có nhiều usser sử dụng textbox ngày tháng và mình muốn sử dụng lại Calender này thì mình viết lệnh như nào để mình dùng đc nhiều chỗ. Vì nếu ghi như vậy thì chỉ sử dụng được một textbox duy nhất!

Bạn cần đăng nhập để thấy hình ảnh


Trong ô thì có activecell, có loại nào activeTextbox ko nhỉ, để khi thao tác với textbox nào thì nó sẽ tự động dán ở texbox đó :D
Đa tạ ad đã trả lời!
 

tuhocvba

Administrator
Thành viên BQT
Có thể suy nghĩ một chút như sau:
Giả thiết tôi có ô textbox1 và ô textbox 2 cùng trên UserForm1.
Trên hàm sự kiện doubleclick của hai ô textbox tôi làm như sau:
Textbox1 double click: tôi gán Label8 trên Calender là màu xanh nhạt.
Textbox2 double click: tôi gán Label8 trên Calender là màu xanh đậm.

Trên class tôi làm như sau:
Nếu Label8 là màu xanh đậm thì điền vào ô textbox2.
Nếu label8 là máu xanh nhạt thì điền vào ô textbox1.
Cụ thể nhé:
Mã:
'Code tren class
If Calender.Label8.BackColor = &HFFFFC0 Then
        'Start
        Userform1.Textbox1.Text = temp
    Else
        UserForm1.Textbox2.Text = temp
    End If
    '&H8000000A
    Unload Calender 'lenh nay tuong tu nhu Hide
Code cho Textbox1:
Mã:
Calender.Label8.BackColor = &HFFFFC0
Code cho Textbox2:
Mã:
Calender.Label8.BackColor = &H8000000A
Bạn cần đăng nhập để thấy đa phương tiện
Về màu RGB bạn có thể tham khảo ở đây:
 

Euler

Administrator
Thành viên BQT
Có thể dùng hai màu dưới đây phù hợp với giao diện lịch hiện tại:
Mã:
Calender.Label8.BackColor = RGB(0,255,130)
Calender.Label8.BackColor = RGB(0,255,135)
Miễn là hai màu khác nhau là được.
Ngoài ra bạn có thể chọn thuộc tính Lock ô textbox để bắt người dùng phải double click, không cho nhập bằng tay.
Bạn cần đăng nhập để thấy hình ảnh
 

tuhocvba

Administrator
Thành viên BQT
Nếu không muốn thay đổi giao diện của calendar thì còn cách khác như sau.

Trên module bất kỳ, bạn dùng biến toàn cục, khai báo như sau, viết ở dòng trên cùng trong module:

Mã:
Public senser as byte 'Định dạng số nguyên, phạm vi từ 0-255
Trên class, bạn viết code như sau (vị trí viết code giống như các bài viết trước đã nói) :

Mã:
    Select case senser
        Case 1
            Userform1.Textbox1.Text = temp
        Case 2
            Userform1.Textbox2.Text = temp
        Case 3
            Userform1.Textbox3.Text = temp
    End select
    Unload Calender
Với các ô textbox bạn xây dựng hàm double click như các bài trước, khác chút xíu. Ví dụ với ô textbox 1:
Mã:
senser = 1
Calender.Show
Với ô textbox 2:
Mã:
senser = 2
Calender.Show
...
Biến toàn cục là biến lưu giá trị ngay cả khi chương trình đã chạy xong mà file excel chưa bị tắt đi.
Thường được khai báo trên đầu module. Khai báo trong module bất kỳ.
Bạn cần đăng nhập để thấy hình ảnh
 
T

thanhphuongvip

Guest
Mình đã làm được. Còn một vấn đề mình muốn hỏi nữa, là mình đã sửa code kiểu định dạng ngày/tháng/năm nhưng khi chọn thì nó vẫn đưa vào textbox vẫn kiểu năm/tháng/ngày?

Bạn cần đăng nhập để thấy hình ảnh


Bạn cần đăng nhập để thấy hình ảnh


Xin mọi người chỉ giúp mình cho nó về định dạng ngày/tháng/năm ạ!

Đa tạ!
 

Euler

Administrator
Thành viên BQT
Mình đã làm được. Còn một vấn đề mình muốn hỏi nữa, là mình đã sửa code kiểu định dạng ngày/tháng/năm nhưng khi chọn thì nó vẫn đưa vào textbox vẫn kiểu năm/tháng/ngày?
Xin mọi người chỉ giúp mình cho nó về định dạng ngày/tháng/năm ạ!
Đa tạ!
Liều mạng thật, bạn không nên chỉnh sửa trong nội dung thân chương trình, nó sẽ gây nên những lỗi không thể kiểm soát.
Cách suy nghĩ như sau:
Chúng ta sẽ xây dựng một hàm để chuyển đổi lại định dạng ngày. Như thế sẽ không gây lỗi cho chương trình.
Step 1: Bạn dán code dưới đây vào module bất kỳ. Đây là hàm được khai báo public cho nên nó có tác dụng ở mọi nơi trong VBA mà gọi tới nó.
Mã:
'Input: 2019/7/13  yyyy-mm-dd
'Output: 13/7/2019  dd-mm-yyyy
'Website: tuhocvba.net
Public Function convertday(ByVal d As String) As String
    Dim nam_temp        As String
    Dim thang_temp      As String
    Dim ngay_temp       As String
    Dim vt1             As Integer
    Dim vt2             As Integer
    
    Const s As String = "/"
    nam_temp = Mid(d, 1, 4) 'lấy năm
    vt1 = InStr(1, d, s) 
'Xác định vị trí / lần một, tìm kiếm từ bên trái chạy sang phải nếu thấy thì dừng.
    vt2 = InStrRev(d, s) 
' Xác định vị trí / lần hai, tìm kiếm từ bên phải sang bên trái, nếu thấy thì dừng.
'Bây giờ xác định ngày và tháng
    thang_temp = Mid(d, vt1 + 1, vt2 - vt1 - 1)
    ngay_temp = Mid(d, vt2 + 1, Len(d) - vt2)
    
    convertday = ngay_temp & "/" & thang_temp & "/" & nam_temp
    
End Function
Bạn cần đăng nhập để thấy hình ảnh


Step 2: Trong Class thêm đoạn code sau vào trước vị trí Msgbox temp:
Mã:
temp = convertday(temp)
Bạn cần đăng nhập để thấy hình ảnh


Ngắm thành quả nhé:
Bạn cần đăng nhập để thấy hình ảnh
 
T

thanhphuongvip

Guest
Đã thử và thành công, cảm ơn ad rất nhiều! Tiện đây cho mình hỏi, câu lệnh Next Tab ở trong VBA là gì thế, mục đích để khi click chọn ngày xong là con trỏ sẽ nhảy sang textbox kế tiếp mà mình ko cần phải nháy chuột, đỡ tốn thời gian!

Xin cảm ơn ạ!
 

tuhocvba

Administrator
Thành viên BQT
cho mình hỏi, câu lệnh Next Tab ở trong VBA là gì thế, mục đích để khi click chọn ngày xong là con trỏ sẽ nhảy sang textbox kế tiếp mà mình ko cần phải nháy chuột, đỡ tốn thời gian!
Nếu điều bạn muốn là như ảnh dưới đây:
Bạn cần đăng nhập để thấy hình ảnh


tức là: Sau khi click chọn lịch cho ô texbox1 thì con trỏ tự nhảy sang ô texbox2 , thì bạn dùng focus:
Cụ thể code trong class được viết thêm như sau:
Mã:
UserForm1.TextBox2.SetFocus
Bạn cần đăng nhập để thấy hình ảnh
 
T

thanhphuongvip

Guest
Nếu điều bạn muốn là như ảnh dưới đây:
Bạn cần đăng nhập để thấy hình ảnh


tức là: Sau khi click chọn lịch cho ô texbox1 thì con trỏ tự nhảy sang ô texbox2 , thì bạn dùng focus:
Cụ thể code trong class được viết thêm như sau:
Mã:
UserForm1.TextBox2.SetFocus
Bạn cần đăng nhập để thấy hình ảnh
Quá chuẩn! Mình đã làm được! Cảm ơn ad lần nữa!!! Chỉ cần setFocus là mọi chuyển ổn thỏa! Mình biết lệnh này nhưng mà ko biết áp dụng vào trường hợp này, ngu thiệt :))
 

Dungbu

Yêu THVBA
Xin được hỏi: Nếu mình muốn lịch ngày chủ nhật chữ xanh nền vàng và thứ 7 cách nhật, hoặc những ngày lễ chuyển sang chữ xanh nền vàng thì làm thế nào?
 

giaiphapvba

Administrator
Thành viên BQT
Xin được hỏi: Nếu mình muốn lịch ngày chủ nhật chữ xanh nền vàng và thứ 7 cách nhật, hoặc những ngày lễ chuyển sang chữ xanh nền vàng thì làm thế nào?
1. Cách thiết định màu cho Label, bạn tham khảo:
Bạn cần đăng nhập để thấy hình ảnh

Nếu vẫn không tự làm được, có lẽ bạn chưa có kiến thức cơ bản. Hãy tham khảo video VBA cơ bản ở đây:

2. Đối với ngày lễ, tự bản thân macro không thể biết ngày nào là ngày lễ, qui định của mỗi quốc gia thế nào là ngày lễ sẽ có sự khác nhau. Do đó người dùng phải tự định nghĩa ngày lễ, sau đó can thiệp bằng code.
 

tuhocvba

Administrator
Thành viên BQT
Cảm ơn bạn đã trả lời. Nhưng ý mình hỏi cách viết hàm để định nghĩa ngày nghỉ được tô màu ý. Mong được chỉ giúp, vì code đơn giản thì viết được nhưng hàm phức tạp thì không biết viết
Ý tưởng của bạn hay đấy. Lúc nào có thời gian mình code cho.
 

Dungbu

Yêu THVBA
Cảm ơn mọi người đã giúp. Mình đã làm được nhưng phải sửa code như @giaiphapvba đã nói, mặc dung không vừa ý. Nếu viết thành hàm thi hay hơn.
Và code sưa:
Mã:
'...…..

If valn >= istart And valn <= iend Then

                'month

                onecontrol.Caption = Day(day1 + valn - istart)

                onecontrol.ForeColor = &H80000012   'color black

                nowtxt = Frame1.Caption & "/" & onecontrol.Caption & " "

                 'Sửa từ đoạn này

                    If valn = 7 Or valn = 14 Or valn = 21 Or valn = 28 Or valn = 35 Then

                    onecontrol.ForeColor = vbRed

                    End If

                    If valn = 6 Or valn = 13 Or valn = 20 Or valn = 27 Or valn = 34 Then

                    onecontrol.ForeColor = vbBlue

                    End If

                    If Month(nowtxt) = 4 And valn = 32 Then

                    onecontrol.ForeColor = vbBlue

                    End If

                    '-- ''

                If InStr(1, nows, nowtxt, 1) > 0 Then

                    onecontrol.BackColor = &HFF00FF

                End If

'...….
Nhìn không ổn :)
 

vbano1

SMod
Thành viên BQT
Cảm ơn mọi người đã giúp.
Bạn lưu ý phải sử dụng thẻ Code khi viết code trên forum. Xin xem mục 4 trong . Tôi đã sửa lại bài viết trên cho bạn. Bạn chú ý.
 

tuhocvba

Administrator
Thành viên BQT
Tôi để màu xanh. Bạn có thể sửa tùy ý thành màu khác ở đây:
Mã:
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:
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 .
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:
Mã:
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:
Mã:
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:

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.
 
D

Deleted member 199

Guest
Cảm ơn admin đã chia sẻ, mình đang cần cái này. Mình đã làm được nhưng muốn sửa để di chuyển nhanh tới một tháng bất kỳ trong năm. Ví dụ, bây giờ đang là tháng 4, nhưng muốn di chuyển tới tháng 10, mình phải ấn Next rất nhiều lần.
Xin được hỏi: Nếu mình muốn ra danh sách các tháng, rồi click di chuyển nhanh tới một tháng thì làm thế nào?
 
Top