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

Hoàng Trọng Nghĩa · 25/9/15

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 · 25/9/15

có vẻ hấp dẫn . bữa giờ em vẫn xài cái này của anh để nhập ngày đấy chứ . hi hi
mà tính vị trí control áp dụng cho cell vẫn được à ta . ngộ ha

Hoàng Trọng Nghĩa · 25/9/15

doveandrose đã viết:
có vẻ hấp dẫn . bữa giờ em vẫn xài cái này của anh để nhập ngày đấy chứ . hi hi
mà tính vị trí control áp dụng cho cell vẫn được à ta . ngộ ha

Kỳ này có vẻ bớt Lag nhiều rồi phải không? Hiệu ứng rê chuột dễ xương không hả? Kakakaka.

0905744404 · 25/9/15

Hoàng Trọng Nghĩa đã viết:
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!

Cái này hay quá anh Nghĩa ơi!

Hoàng Trọng Nghĩa · 25/9/15

0905744404 đã viết:
Cái này hay quá anh Nghĩa ơi!

Cũng mồ hôi và nước mắt bao nhiêu năm trời thay đi đổi lại đó chớ! Tại tự nhiên bị MISSING cái Calendar trong Excel nên điên tiết mà làm cái Calendar tự tạo này đó chớ! ;;;;;;;;;;;

doveandrose · 25/9/15

ý sao vậy ta
[video=youtube;OMndFDkOhLU]https://www.youtube.com/watch?v=OMndFDkOhLU&feature=youtu.be[/video]

0905744404 · 25/9/15

Hoàng Trọng Nghĩa đã viết:
Cũng mồ hôi và nước mắt bao nhiêu năm trời thay đi đổi lại đó chớ! Tại tự nhiên bị MISSING cái Calendar trong Excel nên điên tiết mà làm cái Calendar tự tạo này đó chớ!

Vậy anh hãy "điên tiết" thì còn rất nhiều người được giúp đỡ, cải thiện được công việc
P/s: Những code anh giúp, em đã làm được rất nhiều việc Cám ơn [ Người điên tiết như anh Nghĩa]

Hoàng Trọng Nghĩa · 25/9/15

doveandrose đã viết:
ý sao vậy ta

Bị HO khụ khụ chứ sao! Kakaka, trên máy mình không bị hiện tượng này à nha.
-----------------------------------------------------------------------------------------------------
À, mới thử với các dòng lớn, nó bị vậy, là sao? Cải tiến đi bạn! Kekeke

doveandrose · 25/9/15

Hoàng Trọng Nghĩa đã viết:
Bị HO khụ khụ chứ sao! Kakaka, trên máy mình không bị hiện tượng này à nha.

sửa luôn thì sợ anh Nghĩa giận nên thôi ... lêu lêu

Hoàng Trọng Nghĩa · 25/9/15

doveandrose đã viết:
sửa luôn thì sợ anh Nghĩa giận nên thôi ... lêu lêu

Nếu mà bỏ toàn bộ các phần của mình thêm vô nó cũng đâu có chính xác đâu! Update tiếp đi.

Hoàng Trọng Nghĩa · 25/9/15

Nếu sửa hỏng được thì mình chơi 2 hàm luôn đóa! Hàm bài trước cho Cell, hàm bài sau cho ActiveX Controls là chắc cú nhứt đóa!
--------------------------------------------------------------------------
Ui trời, nóa cũng bị như dzị với Control luôn, ẹc ... ẹc ...

doveandrose · 25/9/15

Hoàng Trọng Nghĩa đã viết:
Nếu sửa hỏng được thì mình chơi 2 hàm luôn đóa! Hàm bài trước cho Cell, hàm bài sau cho ActiveX Controls là chắc cú nhứt đóa!
--------------------------------------------------------------------------
Ui trời, nóa cũng bị như dzị với Control luôn, ẹc ... ẹc ...

cứ từ từ . cái do em làm sao thì em há có thể ngồi nhìn được sao ? ......

Hoàng Trọng Nghĩa · 25/9/15

doveandrose đã viết:
cứ từ từ . cái do em làm sao thì em há có thể ngồi nhìn được sao ? ......

Uh, nhưng cho tới giờ, người ta chưa dùng tới hàng triệu dòng đâu, mà nếu có dùng thì lịch vẫn show lên được!

0905744404 · 25/9/15

Hoàng Trọng Nghĩa đã viết:
Uh, nhưng cho tới giờ, người ta chưa dùng tới hàng triệu dòng đâu, mà nếu có dùng thì lịch vẫn show lên được!

Em dùng MS 2010 đến hàng triệu vẫn chạy ngon mà

Hoàng Trọng Nghĩa · 25/9/15

Left=0, Top=0 là do cái Arr trong Hàm đó không có nên ta tìm hiểu vấn đề ở chỗ này!

doveandrose · 25/9/15

bắc cái thang lên hỏi ông trời vì sao cái này được

Mã:

cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count - 1).Top + _
             vRG(1, 1).Offset(vRG.Rows.Count - 1).Height

nhưng cái này thì lỗi ???

Mã:

cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count).Top

Mã:

Function CellOrControlPosition(ByVal mCtrl As Variant) As Variant
    ''Tac gia: doveandrose (giaiphapexcel.com)
    ''Cap nhat: Hoang Trong Nghia (giaiphapexcel.com) - Chi cap nhat phu them theo y cua minh.
    Dim Arr(1 To 2) As Double, r As Byte, vRG As Range
    Dim recPoint(1 To 4) As Double
    If TypeName(mCtrl) = "Range" Then
        ''Neu khoi o duoc chon, thi cell o hang cuoi, cot cuoi la
        ''vi tri duoc chon de xac dinh:
        Set mCtrl = mCtrl(mCtrl.Rows.Count, mCtrl.Columns.Count)
        ''Chon active de keo cell active dang bi an trong pane ra ngoai:
        mCtrl.Activate
    End If
    With mCtrl
        recPoint(1) = .Top
        recPoint(2) = .Top + .Height
        recPoint(3) = .Left
        recPoint(4) = .Left + .Width
    End With
    With ActiveWindow
        If Not TrackInterSect(recPoint, .ActivePane.VisibleRange) Then
            For r = 1 To .Panes.Count Step 1
                If TrackInterSect(recPoint, .Panes(r).VisibleRange) Then
                    Arr(1) = .Panes(r).PointsToScreenPixelsX(recPoint(3)) * 0.75
                    Arr(2) = .Panes(r).PointsToScreenPixelsY(recPoint(2)) * 0.75
                    Exit For
                End If
            Next
        Else
            Arr(1) = .ActivePane.PointsToScreenPixelsX(recPoint(3)) * 0.75
            Arr(2) = .ActivePane.PointsToScreenPixelsY(recPoint(2)) * 0.75
        End If
    End With
    CellOrControlPosition = Arr
End Function

Mã:

Private Function TrackInterSect(ByVal recPoint As Variant, vRG As Range) As Boolean
Dim cellRec(1 To 4) As Double
cellRec(1) = vRG(1, 1).Top
cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count - 1).Top + _
             vRG(1, 1).Offset(vRG.Rows.Count - 1).Height
cellRec(3) = vRG(1, 1).Left
cellRec(4) = vRG(1, 1).Offset(, vRG.Columns.Count - 1).Left + _
             vRG(1, 1).Offset(, vRG.Columns.Count - 1).Width
             
TrackInterSect = ((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)))
End Function

Hoàng Trọng Nghĩa · 25/9/15

doveandrose đã viết:
bắc cái thang lên hỏi ông trời vì sao cái này được

Mã:

cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count - 1).Top + _ vRG(1, 1).Offset(vRG.Rows.Count - 1).Height

nhưng cái này thì lỗi ???

Mã:

cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count).Top

Ẹc ... ẹc ... có trời mà biết, mình làm biếng nghiên cứu vụ này lắm! Mà công nhận bạn nhanh thiệt đó!

Hoàng Trọng Nghĩa · 25/9/15

doveandrose đã viết:

bắc cái thang lên hỏi ông trời vì sao cái này được

Mã:

cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count - 1).Top + _
             vRG(1, 1).Offset(vRG.Rows.Count - 1).Height

nhưng cái này thì lỗi ???

Mã:

cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count).Top

Mã:

Function CellOrControlPosition(ByVal mCtrl As Variant) As Variant
    ''Tac gia: doveandrose (giaiphapexcel.com)
    ''Cap nhat: Hoang Trong Nghia (giaiphapexcel.com) - Chi cap nhat phu them theo y cua minh.
    Dim Arr(1 To 2) As Double, r As Byte, vRG As Range
    Dim recPoint(1 To 4) As Double
    If TypeName(mCtrl) = "Range" Then
        ''Neu khoi o duoc chon, thi cell o hang cuoi, cot cuoi la
        ''vi tri duoc chon de xac dinh:
        Set mCtrl = mCtrl(mCtrl.Rows.Count, mCtrl.Columns.Count)
        ''Chon active de keo cell active dang bi an trong pane ra ngoai:
        mCtrl.Activate
    End If
    With mCtrl
        recPoint(1) = .Top
        recPoint(2) = .Top + .Height
        recPoint(3) = .Left
        recPoint(4) = .Left + .Width
    End With
    With ActiveWindow
        If Not TrackInterSect(recPoint, .ActivePane.VisibleRange) Then
            For r = 1 To .Panes.Count Step 1
                If TrackInterSect(recPoint, .Panes(r).VisibleRange) Then
                    Arr(1) = .Panes(r).PointsToScreenPixelsX(recPoint(3)) * 0.75
                    Arr(2) = .Panes(r).PointsToScreenPixelsY(recPoint(2)) * 0.75
                    Exit For
                End If
            Next
        Else
            Arr(1) = .ActivePane.PointsToScreenPixelsX(recPoint(3)) * 0.75
            Arr(2) = .ActivePane.PointsToScreenPixelsY(recPoint(2)) * 0.75
        End If
    End With
    CellOrControlPosition = Arr
End Function

Mã:

Private Function TrackInterSect(ByVal recPoint As Variant, vRG As Range) As Boolean
Dim cellRec(1 To 4) As Double
cellRec(1) = vRG(1, 1).Top
cellRec(2) = vRG(1, 1).Offset(vRG.Rows.Count - 1).Top + _
             vRG(1, 1).Offset(vRG.Rows.Count - 1).Height
cellRec(3) = vRG(1, 1).Left
cellRec(4) = vRG(1, 1).Offset(, vRG.Columns.Count - 1).Left + _
             vRG(1, 1).Offset(, vRG.Columns.Count - 1).Width
             
TrackInterSect = ((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)))
End Function

À, hàm trên vẫn còn vướng vấn đề Panes chia màn hình đó nha, bên phải gọi lịch nhưng bên trái show hàng đó!

doveandrose · 25/9/15

Hoàng Trọng Nghĩa đã viết:
À, hàm trên vẫn còn vướng vấn đề Panes chia màn hình đó nha, bên phải gọi lịch nhưng bên trái show hàng đó!

có thật không anh ? hi hi

Hoàng Trọng Nghĩa · 25/9/15

doveandrose đã viết:
có thật không anh ? hi hi

Mình chưa tải quay phim màn hình, chỉ chộp lại thôi, thí nghiệm giống ô giống hàng là biết liền à!

Chỗ khoanh vùng màu đỏ là nơi thao tác chuột đó.

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

Người dùng đang xem chủ đề này

Chuyên gia GPE

File đính kèm

hello

Chuyên gia GPE

Thành viên thường trực

Chuyên gia GPE

hello

Thành viên thường trực

Chuyên gia GPE

hello

Chuyên gia GPE

Chuyên gia GPE

hello

Chuyên gia GPE

Thành viên thường trực

Chuyên gia GPE

hello

Chuyên gia GPE

Chuyên gia GPE

hello

Chuyên gia GPE

File đính kèm

Đếm ngược thời gian