Tặng tiện ích CALENDAR tuyệt đẹp (phần 2 - Phiên bản 5) (2 người xem)

[Hoàng Trọng Nghĩa]

Do phần 1 nhiều bài quá rồi nên khả năng bị loãng cao, vì thế tôi tạo topic mới để giới thiệu một tiện ích không thể thiếu khi nhập ngày tháng cho người không biết lập trình và người biết lập trình để nhúng lịch vào công việc của mình.

Click phải chuột trên Cell để hiện ra menu có chứa lịch, hoặc CTRL+SHIFT+C nha các bạn.

Để thoát mà không nhập gì thì chỉ việc bấm ESC hoặc click vào thanh màu vàng cuối cùng nhé.

------------------------------------------------------------------------------------------------------------

Cải tiến lần này:

1) Nhờ bạn doveandrove và bạn huuthang_bd mà tôi đã xác định tốt vị trí của Cell và ActiveX Controls. Cám ơn các bạn rất nhiều.

2) Về giao diện, tôi đã thay đổi các Label bị ẩn thành các Label có màu xám và hiển thị ngày của tháng trước và tháng kế tiếp.

3) Tạo sự kiện MouseMove cho Label trong Class Module để tạo hiệu ứng rê chuột.

4) Khi nhập trên cell, nếu ô nào có dữ liệu sẽ thông báo trước khi nhập.

5) Và một số cải tiến linh tinh khác trong các thủ tục.

------------------------------------------------------------------------------------------------------------

Ngày hôm nay, tức ngày hiện hành sẽ có màu cam và khung chọn màu đỏ.

Khi di chuyển bằng các phím mũi tên thì ô chọn sẽ có màu vàng nhạt và khung màu xanh đen, nếu bấm Enter là ta chọn ngày đó đồng thời thoát lịch.

Ngoài ra ta chọn ngày cần nhập bằng chuột, khi rê chuột sẽ có một cái khung màu hồng chạy theo con trỏ, cái này không phải là khung chọn đâu nhé, nó chỉ là hiệu ứng đẹp mắt để nhận biết con trỏ đang chạy ở đâu thôi. Còn muốn chọn ngày? Thích thì click!

Thông báo khi cell có dữ liệu:

Nói chung là tải file AddIns về, rồi tải luôn file Hướng dẫn về, một sheet hướng dẫn chi tiết, một sheet ta thực hành chơi cho vui (đọc kỹ hướng dẫn sử dụng trước khi dùng).

Chúc các bạn cảm thấy tiện ích khi sử dụng chương trình này!

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

Mới Update bản mới, gỡ bỏ bản cũ, xác định vị trí trên Cell tốt hơn.

 

[doveandrose]

Vậy chuyên gia xác định vị trí cell làm bản mới đi! Cười cái gì mà cười! Ho nữa bây giờ!

trời đất , cái này dễ ợt mà anh . làm vài ba cái IF là ngọt

 

[Hoàng Trọng Nghĩa]

trời đất , cái này dễ ợt mà anh . làm vài ba cái IF là ngọt

Thôi, nhà ngươi làm luôn đi, có gì sai ta còn có chỗ mà đổi thừa chứ! Kakakaka.

 

[doveandrose]

Thôi, nhà ngươi làm luôn đi, có gì sai ta còn có chỗ mà đổi thừa chứ! Kakakaka.

thêm cái này trước khi ra khỏi ActiveWindow

If Arr(2) + UsfCalendar.Height > Application.Top + Application.Height Then
      Arr(2) = Arr(2) - UsfCalendar.Height - mCtrl.Height * .Zoom / 100
End If

cũng tương tự với Arr(1) nữa

 

[Hoàng Trọng Nghĩa]

thêm cái này trước khi ra khỏi ActiveWindow

If Arr(2) + UsfCalendar.Height > Application.Top + Application.Height Then
      Arr(2) = Arr(2) - UsfCalendar.Height - mCtrl.Height * .Zoom / 100
End If

cũng tương tự với Arr(1) nữa

Lẹ nhệ, làm luôn bên phải đi, nếu cell khuất bên phải thì show hàng bên trái!

 

[doveandrose]

Lẹ nhệ, làm luôn bên phải đi, nếu cell khuất bên phải thì show hàng bên trái!

If Arr(1) + UsfCalendar.Width > Application.Left + Application.Width Then
      Arr(1) = Arr(1) - UsfCalendar.Width
End If

 

[Hoàng Trọng Nghĩa]

If Arr(1) + UsfCalendar.Width > Application.Left + Application.Width Then
      Arr(1) = Arr(1) - UsfCalendar.Width
End If

Anh lại nghĩ vầy chứ:

Arr(1) = Arr(1) - UsfCalendar.Width + mCtrl.Width * .Zoom / 100

Nhưng mà lạ, hàm này lại tự nhiên nhảy vô cái UsfCalendar nhỉ?

 

[doveandrose]

Anh lại nghĩ vầy chứ:

Arr(1) = Arr(1) - UsfCalendar.Width + mCtrl.Width * .Zoom / 100

Nhưng mà lạ, hàm này lại tự nhiên nhảy vô cái UsfCalendar nhỉ?

thử cái biết liền à . có thêm mCtrl.Width * .Zoom / 100 zô nó bị đâm sâu lắm . anh thử đi

 

[Hoàng Trọng Nghĩa]

thử cái biết liền à . có thêm mCtrl.Width * .Zoom / 100 zô nó bị đâm sâu lắm . anh thử đi

Không, hàm đó anh vẫn giữ, không sửa gì cả bởi đó là hàm xác định vị trí Cell, còn Form thì để thủ tục nó xử lý!

Public Sub CalendarOpen(ByVal RangeOrObject As Variant, Optional ByVal usForm As Object)
    ''Bien usForm: Chi dung khi su dung tren UserForm ma thoi.
    On Error Resume Next
    Dim sValue
    Dim NewDate As Date
    Dim myLeft As Single, myTop As Single
    If IsMissing(usForm) Or usForm Is Nothing Then
        Dim myArr
        myArr = CellOrControlPosition(RangeOrObject)
        If IsArray(myArr) Then
            myLeft = myArr(1)
            myTop = myArr(2)
[COLOR=#0000ff]            If myLeft + UsfCalendar.Width > Application.Left + Application.Width Then[/COLOR]
[COLOR=#0000ff]                myLeft = myLeft - UsfCalendar.Width[/COLOR]
[COLOR=#0000ff]                If TypeName(RangeOrObject) = "Range" Then[/COLOR]
[COLOR=#0000ff]                    myLeft = myLeft [/COLOR][COLOR=#ff0000]+ RangeOrObject.Width * ActiveWindow.Zoom / 100[/COLOR][COLOR=#0000ff][/COLOR]
[COLOR=#0000ff]                End If[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
[COLOR=#0000ff]            If myTop + UsfCalendar.Height > Application.Top + Application.Height Then[/COLOR]
[COLOR=#0000ff]                myTop = myTop - UsfCalendar.Height - RangeOrObject.Height * ActiveWindow.Zoom / 100[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]
[COLOR=#0000ff]   [/COLOR] Else
        Dim T As Double, L As Double, E As Double
        With usForm
            E = (.Width - .InsideWidth) / 2
            T = .Top + .Height - .InsideHeight
            L = .Left + E
        End With
        myLeft = RangeOrObject.Left + L
        myTop = RangeOrObject.Top + RangeOrObject.Height + T
    End If
    With UsfCalendar
        .StartUpPosition = 0
        .Left = myLeft
        .Top = myTop
    End With
    sValue = RangeOrObject.Value
    NewDate = DatePicked(sValue)
    If pubIsExit Then
        pubIsExit = False
    Else
        RangeOrObject.Value = NewDate
    End If
End Sub

Anh vẫn giữ cái thằng màu đỏ, bởi nó không bao giờ có chuyện khuất giữa chừng, nếu có thì nó sẽ show ra giữa, còn không nó vẫn ở dưới cái ô đó, không phải vừa dưới mà lại vừa lệch bên trái. Nhưng với ActiveX Controls lại khác nên cho nó show ra phía bên trái là hợp lý.

 

[Hoàng Trọng Nghĩa]

Anh Nguyễn Duy Tuân ơi, ở bài này, mục thứ 3 em muốn hỏi anh là khi chuột ngoài vùng form thoát hay click ở ngoài form thì thoát?

http://www.giaiphapexcel.com/forum/...-đẹp-(phần-2-Phiên-bản-5)&p=676464#post676464

 

[Nguyễn Duy Tuân]

Anh Nguyễn Duy Tuân ơi, ở bài này, mục thứ 3 em muốn hỏi anh là khi chuột ngoài vùng form thoát hay click ở ngoài form thì thoát?

http://www.giaiphapexcel.com/forum/...-đẹp-(phần-2-Phiên-bản-5)&p=676464#post676464

ah, khi bấm chuột ra ngoài nhé.
Còn một cái nữa nếu a làm thì cũng tiện. show form dạng modaless và vẫn chọn được ô khi mở form. Nếu vùng chọn ô ngoài vùng ngày tháng thì ẩn form.

 

[Hoàng Trọng Nghĩa]

ah, khi bấm chuột ra ngoài nhé.
Còn một cái nữa nếu a làm thì cũng tiện. show form dạng modaless và vẫn chọn được ô khi mở form. Nếu vùng chọn ô ngoài vùng ngày tháng thì ẩn form.

OK anh, em nghĩ những thứ này em làm được!

 

[Hoàng Trọng Nghĩa]

ah, khi bấm chuột ra ngoài nhé.
Còn một cái nữa nếu a làm thì cũng tiện. show form dạng modaless và vẫn chọn được ô khi mở form. Nếu vùng chọn ô ngoài vùng ngày tháng thì ẩn form.

Anh Tuân ơi, cái này làm trên sheet thì được rồi đó, còn mở một form và gọi một form dạng modaless thì nó báo lỗi, vậy sao kích hoạt được bên ngoài khi đang mở một form và dùng form đó gọi form calendar được hả anh?