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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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,662
Được thích
16,725
Giới tính
Nam
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 đỏ.

attachment.php


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.

attachment.php


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!

attachment.php


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

attachment.php


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.
 

File đính kèm

  • BanPhim.jpg
    BanPhim.jpg
    62.8 KB · Đọc: 127
  • ReChuot.jpg
    ReChuot.jpg
    63.2 KB · Đọc: 126
  • HuongDan.xls
    HuongDan.xls
    52.5 KB · Đọc: 83
  • HomNay.jpg
    HomNay.jpg
    62.9 KB · Đọc: 124
  • ThongBao.jpg
    ThongBao.jpg
    29 KB · Đọc: 124
  • CalendarShow_V.5.xla
    CalendarShow_V.5.xla
    162.5 KB · Đọc: 97
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
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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 đỏ.

attachment.php


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.

attachment.php


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!

attachment.php


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

attachment.php


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!
Nhấp chuột vào đây để mở rộng...
Cái này hay quá anh Nghĩa ơi!
 
Upvote 0
ý sao vậy ta
[video=youtube;OMndFDkOhLU]https://www.youtube.com/watch?v=OMndFDkOhLU&feature=youtu.be[/video]
 
Upvote 0
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ớ!;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+-+-+-++-+-+-++-+-+-+
Nhấp chuột vào đây để mở rộng...
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]
 
Upvote 0
doveandrose đã viết:
ý sao vậy ta
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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 ...
 
Lần chỉnh sửa cuối:
Upvote 0
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 ...
Nhấp chuột vào đây để mở rộng...

cứ từ từ . cái do em làm sao thì em há có thể ngồi nhìn được sao ? ......
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Ẹ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 đó!
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
À, 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 đó!
 
Upvote 0

File đính kèm

  • ShowHang.jpg
    ShowHang.jpg
    53.7 KB · Đọc: 40
Upvote 0
nói chung cũng có xác suất
[video=youtube;VvMuLlI26GE]https://www.youtube.com/watch?v=VvMuLlI26GE&amp;feature=youtu.be[/video]
 
Upvote 0
Đặt con trỏ tại cột XEN đi, mỗi một ô phần tô đỏ click 100 lần đúng 100 lần bị chạy chứ xác suất gì!+-+-+-++-+-+-+;;;;;;;;;;;;;;;;;;;;;;

Thôi, update tiếp đi em trai! --=0--=0--=0
 

File đính kèm

  • KhuKhu.jpg
    KhuKhu.jpg
    78.2 KB · Đọc: 31
Upvote 0
doveandrose đã viết:
bệnh nặng sắp chết rồi ấy chứ . anh thử xài với hàm cellPosition xem có bị với cell không ?
Nhấp chuột vào đây để mở rộng...
Bị luôn! Khụ khụ tiếp đi nhé! kakakakakakakakakaka;;;;;;;;;;;

Mà thôi, thế quái nào mà sửa hoài, tính tương đối thôi chứ tuyệt đối sao làm nổi! Anh Bill còn khụ khụ nữa là!
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...
Có 2 ý nhờ anh bổ sung giúp
- Bổ sung chỗ Click vào đây chọn ngày hôm nay chưa chạy ạ
- Khi Click Cell chọn ngày thì khi chọn xong nó AutoFit Cell đó được không ạ, đừng để khi chọn xong nó như thế này #######
 
Upvote 0
quyenpv đã viết:
Có 2 ý nhờ anh bổ sung giúp
- Bổ sung chỗ Click vào đây chọn ngày hôm nay chưa chạy ạ
- Khi Click Cell chọn ngày thì khi chọn xong nó AutoFit Cell đó được không ạ, đừng để khi chọn xong nó như thế này #######
Nhấp chuột vào đây để mở rộng...

Chỗ "click vào đây..." tức click vào Label trên Label thoát, có Caption là Thứ x ngày y tháng z, d/m-can chi đó.

Cái autofit đó quá dễ, song tôi không can thiệp vào cấu trúc của file người khác, người này bảo autofit, người kia bảo font chữ nhỏ v.v... thì làm sao đáp ứng, vả lại, cột ngày tháng của mình thì mình tự biết độ rộng của nó như thế nào, font chữ ra sao, định dạng thế nào v.v...
 
Upvote 0
quyenpv đã viết:
Trên máy em không thấy có tác dụng, anh kiểm tra lại giúp ạ
Nhấp chuột vào đây để mở rộng...
Chọn ở đây là cái khung chọn nó đang ở ngày khác ngày hôm nay, giả sử hôm nay là 26/9 thì mặc định khung chọn (màu đỏ) nó nằm tại đây, nên không thay đổi gì. Nếu bạn dùng phím mũi tên cho lên xuống qua lại, sẽ thấy khung chọn màu xanh đen, màu nền là màu vàng nhạt, hoặc tại ô chọn có sẳn ngày mà không phải là ngày hôm nay, lịch cũng hiện lên ngày đó, lúc này muốn trở về ngày hiện hành thì click vào đó, muốn NHẬP ngày đó vào đối tượng thì bấm Enter hoặc click chọn thôi.

CHỌN LÀ CHỌN LỰA CHỨ KHÔNG PHẢI LÀ NHẬP VÔ ĐỐI TƯỢNG NHÉ.
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Đặt con trỏ tại cột XEN đi, mỗi một ô phần tô đỏ click 100 lần đúng 100 lần bị chạy chứ xác suất gì!+-+-+-++-+-+-+;;;;;;;;;;;;;;;;;;;;;;

Thôi, update tiếp đi em trai! --=0--=0--=0
Nhấp chuột vào đây để mở rộng...

anh Nghĩa up lên cho em mượn cái file nào tỉ lệ hiện ra sai nhiều cái . nãy giờ em xài code #16 đâu có chỉnh sửa gì mà nó cứ chạy đúng hoài sao đỡ được ? giống như kiểu theo tình thì tình chạy =))
 
Upvote 0
doveandrose đã viết:
anh Nghĩa up lên cho em mượn cái file nào tỉ lệ hiện ra sai nhiều cái . nãy giờ em xài code #16 đâu có chỉnh sửa gì mà nó cứ chạy đúng hoài sao đỡ được ? giống như kiểu theo tình thì tình chạy =))
Nhấp chuột vào đây để mở rộng...
Thôi được rồi, chuyện xảy ra xác suất không đáng kể đâu, thống nhất là lấy code bài 16 làm hàm xác định vị trí vậy.
 
Upvote 0
Add-in này rất hay đó a Nghĩa. Có vài thứ nếu có time a nâng câp xem thế nào?
1. Vị trí form không đúng vị trí của Cell. Hiện nay chỉ đúng trên userform còn trên sheet lỗi (test trên Excel 2013). Thấy bảo cập nhật code bài #16 nhưng không biết file tại bài #1 update chưa?
2. Vị trí của form luôn hiển thị phía dưới của Cell, nếu Cell nằm dưới đáy màn hình thì form bị ẩn phía dưới không xem được. Cái này viết code để nhận biết nếu hiển thị phíadưới không đủ thì hiện phía trên.
3. Khi form hiện ra phải nhấn ESC để thoát. Liệu có thể làm thêm khi tọa độ chuột khoài form thì đóng form luôn.
4. Cái dòng chữ thông báo "Bấm vào đây..." làm tốn diện tích Có thể dùng biểu tượng [X] góc phải form (ai cũng biết là đóng).

Thanks!
 
Upvote 0
Nguyễn Duy Tuân đã viết:
Add-in này rất hay đó a Nghĩa. Có vài thứ nếu có time a nâng câp xem thế nào?
1. Vị trí form không đúng vị trí của Cell. Hiện nay chỉ đúng trên userform còn trên sheet lỗi (test trên Excel 2013). Thấy bảo cập nhật code bài #16 nhưng không biết file tại bài #1 update chưa?
2. Vị trí của form luôn hiển thị phía dưới của Cell, nếu Cell nằm dưới đáy màn hình thì form bị ẩn phía dưới không xem được. Cái này viết code để nhận biết nếu hiển thị phíadưới không đủ thì hiện phía trên.
3. Khi form hiện ra phải nhấn ESC để thoát. Liệu có thể làm thêm khi tọa độ chuột khoài form thì đóng form luôn.
4. Cái dòng chữ thông báo "Bấm vào đây..." làm tốn diện tích Có thể dùng biểu tượng [X] góc phải form (ai cũng biết là đóng).

Thanks!
Nhấp chuột vào đây để mở rộng...
Cám ơn Anh đã quan tâm, em vừa mới Up bản cũ thay bản mới với code xác định vị trí ở bài 16.

2. Vị trí của form luôn hiển thị phía dưới của Cell, nếu Cell nằm dưới đáy màn hình thì form bị ẩn phía dưới không xem được. Cái này viết code để nhận biết nếu hiển thị phíadưới không đủ thì hiện phía trên.
Nhấp chuột vào đây để mở rộng...

Cái này em cũng đang nghiên cứu đây, tạm thời nếu nó xuống quá thì lôi nó lên bằng cách kéo thả, giữ chuột trên các Label thứ (HAI, BA, TƯ ...) rồi dời nó lên thôi.

3. Khi form hiện ra phải nhấn ESC để thoát. Liệu có thể làm thêm khi tọa độ chuột khỏi form thì đóng form luôn.
Nhấp chuột vào đây để mở rộng...

Chuột rời khỏi cũng nhiều kiểu lắm, vậy có động tác click ngoài form thoát lịch hay không anh? Chứ việc rê qua rê lại đôi khi cũng chạy ra ngoài form à.

4. Cái dòng chữ thông báo "Bấm vào đây..." làm tốn diện tích Có thể dùng biểu tượng [X] góc phải form (ai cũng biết là đóng).
Nhấp chuột vào đây để mở rộng...

thêm thì dịch mấy em combobox và button dịch vào trong một tí, OK, cũng làm được ngay đó mà! Hihihi.
 
Upvote 0
Hi Nghĩa!
Nên chăng khi kích hoạt cho lịch hiện hành trên sheet, thì vẫn di chuyển trỏ chuột được các ô trong excel (hiện tại thì không được)?
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Cái này em cũng đang nghiên cứu đây, tạm thời nếu nó xuống quá thì lôi nó lên bằng cách kéo thả, giữ chuột trên các Label thứ (HAI, BA, TƯ ...) rồi dời nó lên thôi.
Nhấp chuột vào đây để mở rộng...
Form nằm ở đâu hoàn toàn do người thiết kế . bắt người dùng cầm form kéo đi là thua rồi . hi hi --=0--=0--=0
 
Upvote 0
Hoàng Trọng Nghĩa đã viế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.
Nhấp chuột vào đây để mở rộng...
thêm cái này trước khi ra khỏi ActiveWindow
Mã: 
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ần chỉnh sửa cuối:
Upvote 0
doveandrose đã viết:
thêm cái này trước khi ra khỏi ActiveWindow
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
Upvote 0
doveandrose đã viết:
Mã: 
If Arr(1) + UsfCalendar.Width > Application.Left + Application.Width Then
      Arr(1) = Arr(1) - UsfCalendar.Width
End If
Nhấp chuột vào đây để mở rộng...

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ỉ?
 
Upvote 0
doveandrose đã viết:
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
Nhấp chuột vào đây để mở rộng...
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ý!

Mã: 
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ý.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
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
Nhấp chuột vào đây để mở rộng...

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.
 
Upvote 0
Upvote 0
Nguyễn Duy Tuân đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (1 người xem)
Trả lời
9
Đọc
448
Gà Con yêu VBA
Gà Con yêu VBA
Ả
Cách tạo list Data validation không qua trung gian (5 người xem)
Trả lời
46
Đọc
7K
thuytrangbp28
T
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ (4 người xem)
Trả lời
15
Đọc
2K
anhdepjai
A
T
[Giúp đỡ] Sửa lỗi runtime error 1004 application defined or object defined
Trả lời
2
Đọc
100
tmhung0805
T
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
280
Đọc
35K
hoangtuan.net
hoangtuan.net
M
  • Question Question
[Hỏi cách tạo VBA] - Xin các cao nhân chỉ giúp cách tạo VBA cho công việc thuận tiện hơn (1 người xem)
Trả lời
5
Đọc
229
SA_DQ
SA_DQ
dongbhhg
Hàm đếm số lượng trong khoảng thời gian cho trước
Trả lời
6
Đọc
162
thanthanhan
thanthanhan
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
399
Đọc
47K
BlueSphere
B
N
Tạo file lưu trữ dữ liệu tự động trên excel. (1 người xem)
Trả lời
12
Đọc
296
DeTong
D
D
  • Đã khóa
lọc các ô trong một cột chứa một nhóm dữ liệu? mong các cao thủ giải đáp giúp mình
Trả lời
6
Đọc
172
ptm0412
ptm0412
S
cần xử lý dữ liệu trùng nhau bằng VBA (1 người xem)
    • Cười
Trả lời
9
Đọc
268
HUONGHCKT
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết
Trả lời
27
Đọc
25K
Anh2207
A
P
In file excel có cột bị gộp (3 người xem)
Trả lời
0
Đọc
66
ple28
P
N
  • Question Question
Tạo file lưu trữ dự liệu tự động
Trả lời
8
Đọc
259
le_vis
L
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
573
ongke0711
ongke0711
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
3
Đọc
179
HieuCD
H
D
in ra bị thiếu chữ
Trả lời
4
Đọc
146
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
124
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
108
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom