Tặng tiện ích CALENDAR tuyệt đẹp!

Liên hệ QC
Hoàng Trọng Nghĩa

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,611
Được thích
16,671
Giới tính
Nam
***************************************************************************************************************
***************************************************************************************************************
Đã có phiên bản mới tại đây:

Tặng tiện ích CALENDAR (Excel 2007 trở về sau)​


***************************************************************************************************************
***************************************************************************************************************



Nhân dịp khoác trên vai “4 sao vàng”, tôi xin tặng các bạn một UserForm Calendar tuyệt đẹp, nó không những thay thế được với Control Calendar của Excel mà nó còn hiển thị ngày Âm lịch.

(Giới thiệu trước, gửi file ở bài sau)
3.jpg​

Mặc dù mã nguồn tôi đã sưu tầm từ nhiều nơi (thật sự tôi không nhớ nguồn gốc của các mã này của ai sáng tác), nhưng tôi đã cải tiến cũng như thiết kế lại giao diện, kết hợp mã nguồn của dương lịch và mã nguồn chuyển Âm lịch, có đầy đủ “thiên can địa chi” cho năm.

Cũng như tại bài viết này tôi đã giới thiệu (http://www.giaiphapexcel.com/forum/showthread.php?36542-Đặt-caption-cho-nhiều-Label&p=242247#post242247) thì cải tiến lần này hoàn chỉnh nhất, Calendar này sẽ nhớ ngày hiện hành (hôm nay) bằng cách tô màu hồng đậm. Dùng phím mũi tên (lên, xuống, trái, phải) để di chuyển giữa các ô ngày; mỗi ô ngày được chọn sẽ có nền trắng, viền ngoài để phân biệt với ngày hiện hành và các ngày trong tháng.

Các bạn để ý sẽ thấy, khi ô ngày nào được chọn, thì Label ở dưới cùng thể hiện ngày Dương lịch được chọn bên trái và ngày Âm lịch được chọn bên phải, chúng có màu nền, cũng như màu font chữ của ô ngày hiện hành.

Cũng tại Label này, khi bạn đang chọn ngày khác với ngày hiện hành, thì bạn click vào đó nó sẽ chọn về ngày hôm nay.

2.jpg​

Nếu bạn rê chuột ngang qua nó, nó sẽ show cho bạn một ToolTip để báo bạn biết chức năng của nó.

Đặc biệt, lần cải tiến này tôi đã thay đổi 2 Label tháng và năm thành 2 ComboBox THÁNG & NĂM để chúng ta có thể di chuyển ngay tới tháng hoặc năm cần xem.

1.jpg

– Chọn tháng –

4.jpg

– Chọn năm –

5.jpg
​

Các thao tác trên lịch:

  • Di chuyển giữa các ô ngày bằng các phím mũi tên để di chuyển qua lại, lên xuống.
  • Dùng phím Tab để di chuyển ngày kế tiếp, shift + tab để di chuyển ngược lại.
  • PgUp, PgDn để chọn tháng trước, tháng sau (tương đương với bấm vào 2 CommandButton mũi tên qua, lại sát ComboBox Tháng, cũng tương đương Shift + các phím mũi tên).
  • Shift+ PgUp/ PgDn để chọn năm trước, năm sau (tương đương với bấm vào 2 CommandButton mũi tên qua, lại sát ComboBox Năm).
  • Phím Home để trở về ngày hiện hành (ngày hôm nay).

Các bạn cứ bấm thử với Shift hoặc Ctrl kết hợp với các phím trên sẽ nắm rõ nguyên lý hoạt động của lịch.

Với phím Enter, Esc hoặc click vào ô ngày nào đó sẽ thoát lịch.

Nếu lịch được khởi động trên một UserForm và muốn nhận giá trị ngày từ Calendar vào một TextBox trên form này, thì sau khi thoát Lịch, giá trị lịch tại ô ngày nào được chọn sẽ nhập vào TextBox của UserForm đó.

Năm nào có tháng nhuần thì nó thể hiện chữ (N) trên Calendar.

6.jpg​
Khi gọi Calendar từ một UserForm, nếu TextBox cần nhập Date có sẳn ngày tháng, lịch sẽ lấy ngày đó làm ngày hiển thị, ngược lại, lịch sẽ hiển thị ngày hiện hành.

7.jpg
​
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
xin được góp ý về 1 chỗ chưa hợp lý trên addin
hình như anh có tạo phím tắt Escape dùng để thoát Form , và khi thoát Form thì nội dung của cell vừa Active cũng bị xóa luôn
đó là sự bất hợp lý vì khi người dùng bấm Escape đó là dấu hiệu cho thấy họ không muốn lấy nội dung gì từ Calendar cả , nhưng nội dung hiện hành của Active cell thì cần phải giữ nguyên như lúc chưa Show Form . mong anh để ý giúp
 
Upvote 0
doveandrose đã viết:
xin được góp ý về 1 chỗ chưa hợp lý trên addin
hình như anh có tạo phím tắt Escape dùng để thoát Form , và khi thoát Form thì nội dung của cell vừa Active cũng bị xóa luôn
đó là sự bất hợp lý vì khi người dùng bấm Escape đó là dấu hiệu cho thấy họ không muốn lấy nội dung gì từ Calendar cả , nhưng nội dung hiện hành của Active cell thì cần phải giữ nguyên như lúc chưa Show Form . mong anh để ý giúp
Nhấp chuột vào đây để mở rộng...
Đang cập nhật bản mới nhất có nội dung như:

1) Về giao diện, không ẩn những Label mà vẫn để chúng show ra với dạng ngày tháng trước và ngày tháng sau trong 42 cái label DL và 42 cái AL. Khi click vào đây sẽ đỡ phải bấm chạy qua tháng trước hoặc tháng sau một vài ngày. Giao diện sẽ nhẹ nhàng hơn một tí.

2) Có một Label phía dưới cùng khi click vào sẽ thoát form và không ghi gì cả.

3) Nếu vùng (khối ô) được chọn sẽ cảnh báo trước.

4) Nếu vùng có dữ liệu sẽ thông báo. Nếu ô có dữ liệu thì hiển thị dữ liệu đó trên msgbox và hỏi có muốn thay thế hay không. Còn nếu vùng/ ô được chọn không có dữ liệu thì sẽ không hỏi gì.

5) Đang viết hiệu ứng rê chuột, sẽ sớm hoàn thiện thôi.

Nhưng chắc sẽ tạo một topic mới để mọi người dễ dàng truy cập.
 
Upvote 0
Đã hoàn tất phiên bản V.5 rồi nhé! Ngày mai gửi tặng các bạn! Giờ nhá hàng thôi, làm mấy file một lúc nên đuối lắm rồi!

Đó, khi rê chuột trên Label nó có cái khung hồng hồng chạy theo con chuột đó. Để làm được điều này trên 42 Label là chuyện khủng khiếp đó, nhưng ta viết sự kiện MouseMove cho Label trong Class thì OK (sự kiện này không có sẳn trong Class nên ta phải tạo ra nó).

Và những ngày tháng xám xám là ngày của tháng trước hoặc ngày của tháng sau.
 

File đính kèm

  • ReChuot.jpg
    ReChuot.jpg
    63.2 KB · Đọc: 75
Upvote 0
Định gửi bài lên rồi, nhưng còn vướng một điểm là xác định vị trí!

Có 3 vị trí cần tìm trong một file Excel đó là:

1) Cell trên worksheet,

2) Control trên form,

3) Control trên worksheet.

Ta có thể tìm được 2 cái trên, vậy cái thứ 3 sao tìm ra vị trí được ta, giúp mình cái này luôn đi. Vị trí này giống y vị trí của Cell, nó cũng lệ thuộc Zoom, Freeze Pane v.v...
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Định gửi bài lên rồi, nhưng còn vướng một điểm là xác định vị trí!

Có 3 vị trí cần tìm trong một file Excel đó là:

1) Cell trên worksheet,

2) Control trên form,

3) Control trên worksheet.

Ta có thể tìm được 2 cái trên, vậy cái thứ 3 sao tìm ra vị trí được ta, giúp mình cái này luôn đi. Vị trí này giống y vị trí của Cell, nó cũng lệ thuộc Zoom, Freeze Pane v.v...
Nhấp chuột vào đây để mở rộng...

hoặc là anh tải lên cho em mượn cái addin hoặc là anh xem cái này
anh nói Control trên Worksheet tức là nói về 1 textbox được tạo trên sheet ?
vậy thì nó đâu khác gì 1 cell đâu . anh thay đối số hàm CellPosition cho nhận vào 1 kiểu Variant (có khi là Cell có khi là Textbox)

để biết textbox thuộc về panes nào thì anh chạy cái này
Mã: 
With ActiveWindow
Dim r As Byte, vRG As Range
For r = 1 To .Panes.Count Step 1
    Set vRG = .Panes(r).VisibleRange
    If vRG(1, 1).Top <= Sheet1.TextBox2.Top And _
       vRG(1, 1).Offset(vRG.Rows.Count).Top >= Sheet1.TextBox2.Top And _
       vRG(1, 1).Left <= Sheet1.TextBox2.Left And _
       vRG(1, 1).Offset(, vRG.Columns.Count).Left >= Sheet1.TextBox2.Left Then
        Exit For
    End If
Next
End With
MsgBox r

khi đã biết textbox thuộc về panes nào rồi thì chuyện còn lại đâu có gì phải bàn nữa
có điều em thấy phải chỉnh StartUpPosition của Form thành Manual mới hiển thị đúng với textbox trên sheet
 
Upvote 0
ở trên vẫn chưa đúng khi textbox nằm khuất chứ không nằm trọn trong 1 panel . để tìm cách khác vậy
===============================================================
hàm tìm vị trí của Textbox trên Sheet , hàm CellPosition thôi ta giữ nguyên
Mã: 
Public Function ControlPosition(ByVal mCtrl As Variant) As Variant
Dim arr(1 To 2) As Double, r As Byte, vRG As Range
Dim recPoint(1 To 4) As Double, cellRec(1 To 4) As Double
With mCtrl
    recPoint(1) = .Top
    recPoint(2) = .Top + .Height
    recPoint(3) = .Left
    recPoint(4) = .Left + .Width
End With
With ActiveWindow
    For r = 1 To .Panes.Count Step 1
        Set vRG = .Panes(r).VisibleRange
        cellRec(1) = vRG(1, 1).Top
        cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count).Top
        cellRec(3) = vRG(1, 1).Left
        cellRec(4) = vRG(1, 1).Offset(, vRG.Columns.Count).Left
        If ((cellRec(1) <= recPoint(1) And cellRec(2) >= recPoint(1)) Or ( _
            cellRec(1) <= recPoint(2) And cellRec(2) >= recPoint(2))) _
        And _
           ((cellRec(3) <= recPoint(3) And cellRec(4) >= recPoint(3)) Or ( _
            cellRec(3) <= recPoint(4) And cellRec(4) >= recPoint(4))) Then
            arr(1) = .Panes(r).PointsToScreenPixelsX(recPoint(3)) * 0.75
            arr(2) = .Panes(r).PointsToScreenPixelsY(recPoint(2)) * 0.75
            Exit For
        End If
    Next
End With
ControlPosition = arr
End Function

như thế hình thành ra 3 trường hợp
Application.Run "'CalendarShow.xla'!CalendarOpen", ActiveCell
Application.Run "'CalendarShow.xla'!CalendarOpen", Sheet1.TextBox2
Application.Run "'CalendarShow.xla'!CalendarOpen", Me.TextBox1, Me
 
Lần chỉnh sửa cuối:
Upvote 0
doveandrose đã viết:
ở trên vẫn chưa đúng khi textbox nằm khuất chứ không nằm trọn trong 1 panel . để tìm cách khác vậy
===============================================================
hàm tìm vị trí của Textbox trên Sheet , hàm CellPosition thôi ta giữ nguyên
Mã: 
Public Function ControlPosition(ByVal mCtrl As Variant) As Variant
Dim arr(1 To 2) As Double, r As Byte, vRG As Range
Dim recPoint(1 To 4) As Double, cellRec(1 To 4) As Double
With mCtrl
    recPoint(1) = .Top
    recPoint(2) = .Top + .Height
    recPoint(3) = .Left
    recPoint(4) = .Left + .Width
End With
With ActiveWindow
    For r = 1 To .Panes.Count Step 1
        Set vRG = .Panes(r).VisibleRange
        cellRec(1) = vRG(1, 1).Top
        cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count).Top
        cellRec(3) = vRG(1, 1).Left
        cellRec(4) = vRG(1, 1).Offset(, vRG.Columns.Count).Left
        If ((cellRec(1) <= recPoint(1) And cellRec(2) >= recPoint(1)) Or ( _
            cellRec(1) <= recPoint(2) And cellRec(2) >= recPoint(2))) _
        And _
           ((cellRec(3) <= recPoint(3) And cellRec(4) >= recPoint(3)) Or ( _
            cellRec(3) <= recPoint(4) And cellRec(4) >= recPoint(4))) Then
            arr(1) = .Panes(r).PointsToScreenPixelsX(recPoint(3)) * 0.75
            arr(2) = .Panes(r).PointsToScreenPixelsY(recPoint(2)) * 0.75
            Exit For
        End If
    Next
End With
ControlPosition = arr
End Function

như thế hình thành ra 3 trường hợp
Application.Run "'CalendarShow.xla'!CalendarOpen", ActiveCell
Application.Run "'CalendarShow.xla'!CalendarOpen", Sheet1.TextBox2
Application.Run "'CalendarShow.xla'!CalendarOpen", Me.TextBox1, Me
Nhấp chuột vào đây để mở rộng...
Quả thật làm việc theo nhóm thật thú vị, tôi sẽ test kỹ hàm này, sau đó gửi lên version mới luôn! Cám ơn bạn.
 
Upvote 0
huuthang_bd đã viết:
Nên chăng sửa lại như vầy
PHP: 
Public Function CellPositionC(ByVal rCell As Range) As Variant
Dim arr(1 To 2) As Double, r As Byte
With ActiveWindow
    If Intersect(.ActivePane.VisibleRange, rCell) Is Nothing Then
        For r = 1 To .Panes.Count
            If Not Intersect(.Panes(r).VisibleRange, rCell) Is Nothing Then
                arr(1) = .Panes(r).PointsToScreenPixelsX(rCell.Left) * 0.75
                arr(2) = .Panes(r).PointsToScreenPixelsY(rCell.Offset(1).Top) * 0.75
                Exit For
            End If
        Next
    Else
        arr(1) = .ActivePane.PointsToScreenPixelsX(rCell.Left) * 0.75
        arr(2) = .ActivePane.PointsToScreenPixelsY(rCell.Offset(1).Top) * 0.75
    End If
End With
CellPositionC = arr
End Function
Nhấp chuột vào đây để mở rộng...
Có cách nào đưa hàm này qua VB.Net được không mọi người. Mình chuyển qua Form không đúng vị trí ạ
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Có thể nói cái lịch này là một tiện ích "có thể" thay thế được với control Caledar của Excel VBA, giao diện thân thiện hơn, dễ chỉnh sửa, nói chung là dễ cá nhân hóa nó theo ý thích.

Nhập ngày tháng nhanh chóng bất cứ ở đâu, trên form hoặc trên sheet

Coi ngày tháng Âm lịch từ ngày 01/02/1900 (DL) đến 14/2/2200 (DL)

Nhập liệu nhanh chóng trên sheet thì chúng ta có thể làm một nút lệnh trên Cell Menu như sau:

Trong Module ThisWorkBook, đặt 2 thủ tục này để tạo Menu:

Mã: 
Private Sub Workbook_Activate()
    With Application.CommandBars("Cell")
        .Reset
        .Controls("cut").BeginGroup = True
        .Controls.Add(1, , , 1).Caption = "Calendar"
        With .Controls("Calendar")
            .Style = 3
            .FaceId = 59
            .BeginGroup = True
            .OnAction = "CalShow"
        End With
    End With
End Sub

Private Sub Workbook_Deactivate()
    Application.CommandBars("Cell").Reset
End Sub

Khi click chuột phải sẽ như thế này:

attachment.php


Sau khi chọn vào Calendar thì lịch được show như vầy:

attachment.php


Chỉ việc bấm chọn ngày tháng cần thiết vào ô hoặc khối ô được chọn, chỉ với thủ tục như thế này thôi:

Mã: 
Sub CalShow()
      Dim Ftop As Double, Fleft As Double
      With Selection
            Fleft = .Left [COLOR=#ff0000]+ 22[/COLOR] [COLOR=#008000]'Màu đỏ có thể chưa chính xác cho từng loại Window[/COLOR]
            Ftop = .Top + .Height[COLOR=#ff0000] + 110[/COLOR]
            With UsfCalendar
                  .StartUpPosition = 0
                  .Top = Ftop
                  .Left = Fleft
            End With
            .Value = DatePicked(.Value)
      End With
End Sub

=======================================================

Xa hơn nữa, sẽ định cải tiến trên cơ sở dữ liệu (nhỏ thôi) các ghi chú, sinh nhật, nhắc nhở v.v...

Mà thôi, thấy chẳng ai bận tâm, thậm chí chỉ một vài người cám ơn (mặc dù đã tải hơn 120 lần) nên chẳng muốn cải tiến tí nào!
Nhấp chuột vào đây để mở rộng...
Hi bạn
Mình có userform mà gọi lịch không được, mình thì mù VBA nên nhờ được giúp dỡ ạ.
Không biết cách nào để có lịch trên form hết
Cám ơn nhiều ạ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

hongquan93vn
Giữ được Hide dòng khi dùng "clear" trong phần học
Trả lời
4
Đọc
81
ngocmaipretty
ngocmaipretty
K
Set macro là disable nhưng file macro vẫn chạy !
Trả lời
3
Đọc
48
kietbui
K
C
  • Question
Tạo schedule chạy code VBA
Trả lời
5
Đọc
206
castanea
C
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
25
Đọc
435
Hoàng Tuấn 868
H
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
10
Đọc
265
phammaihuong90
phammaihuong90
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom