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,623
Được thích
16,682
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
Hoàng Trọng Nghĩa đã viết:
Tôi nghĩ là nên như vầy:

Mã: 
Public Function CellPositionC(ByVal rCell As Range) As Variant
    Dim arrLeftTop(1 To 2) As Double, r As Byte
[B][COLOR=#ff0000]    Set rCell = rCell(1, 1): rCell.Activate[/COLOR][/B]
    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
                    arrLeftTop(1) = .Panes(r).PointsToScreenPixelsX(rCell.Left) * 0.75
                    arrLeftTop(2) = .Panes(r).PointsToScreenPixelsY(rCell.Top) * 0.75 [COLOR=#ff0000][B]+ rCell.Height[/B][/COLOR]
                    Exit For
                End If
            Next
        Else
            arrLeftTop(1) = .ActivePane.PointsToScreenPixelsX(rCell.Left) * 0.75
            arrLeftTop(2) = .ActivePane.PointsToScreenPixelsY(rCell.Top) * 0.75 [COLOR=#ff0000][B]+ rCell.Height[/B][/COLOR]
        End If
    End With
    CellPositionC = arrLeftTop
End Function
Nhấp chuột vào đây để mở rộng...
AddIn hông nên tự ý thay đổi vùng chọn và/hoặc ô hiện hành. Một số người dùng sẽ thấy khó chịu vì vấn đề này.
 
Upvote 0
huuthang_bd đã viết:
AddIn hông nên tự ý thay đổi vùng chọn và/hoặc ô hiện hành. Một số người dùng sẽ thấy khó chịu vì vấn đề này.
Nhấp chuột vào đây để mở rộng...


Ở đây nó không thay đổi vùng chọn vì nó chỉ căn cứ Cell đầu tiên của vùng thôi, nếu không làm vậy, chọn nguyên khối ô chắc nó trừ cái Height của ô đó chắc khủng lắm nhỉ? Chọn nguyên khối ô, rồi cho ô đầu tiên Active và cho Form hiển thị dưới ô đó, nhưng kết quả không thay đổi sau khi Unload Form thì đâu có gì phải lo đúng không.

Cái này mới lo nè:

arr(2) = .ActivePane.PointsToScreenPixelsY(rCell.Offset(1).Top) * 0.75

Vì nó sẽ phát sinh lỗi (hiếm ai sử dụng đến dòng cuối cùng, nhưng cũng phải loại trừ).

Còn cái này lại khác, kết quả không khác, nhưng an toàn:

arrLeftTop(2) = .ActivePane.PointsToScreenPixelsY(rCell.Top) * 0.75 + rCell.Height
 
Upvote 0
vừa rồi em có xem bản xla của anh trên FB có chỗ này chưa đúng
Mã: 
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long[COLOR=#ff0000][SIZE=3][B]Ptr[/B][/SIZE][/COLOR]

nó sẽ gây ra lỗi type mismatch ở dòng
Mã: 
hForm = FindWindow("ThunderDFrame", Me.Caption)
anh chỉ cần bỏ chữ Ptr màu đỏ đi là được

tiếp theo là về hiệu ứng . nếu có thể được . em để xuất anh nên tạo ra hiệu ứng khi hơ chuột qua từng ngày . đó có thể là đổi màu ô đó hoặc gì đó tùy . miễn sao người dùng nhận ra là đang rê chuột lên ô nào là được .

cuối cùng là khi click vào các nút hình mũi tên trên Form cảm giác hơi Lag thì phải . hi vọng đây chỉ là cảm giác nhất thời . em không chắc về điều này : xem hàm FixDaysInMonth từ phần
Dim a As String, b As String, c As String, d As String
trở xuống liệu có cần thiết chăng ? hay do em chưa nắm rõ ý nghĩa phần này ?
 
Upvote 0
doveandrose đã viết:
vừa rồi em có xem bản xla của anh trên FB có chỗ này chưa đúng
Mã: 
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long[COLOR=#ff0000][SIZE=3][B]Ptr[/B][/SIZE][/COLOR]

nó sẽ gây ra lỗi type mismatch ở dòng
Mã: 
hForm = FindWindow("ThunderDFrame", Me.Caption)
anh chỉ cần bỏ chữ Ptr màu đỏ đi là được
Nhấp chuột vào đây để mở rộng...
Tiện đây bạ cho mình hỏi nhân việc bạn bảo bỏ Ptr đi thì hàm sau không còn lỗi. Nhưng bỏ Ptr trong biến lại bị lỗi
#If VBA7 And Win64 Then 'Office 64-bit
Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As LongPtr) As Long
#Else ' Office 32-bit
Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#End If
 
Lần chỉnh sửa cuối:
Upvote 0
viehoai đã viết:
Tiện đây bạ cho mình hỏi nhân việc bạn bảo bỏ Ptr đi thì hàm sau không còn lỗi. Nhưng bỏ Ptr trong biến lại bị lỗi
#If VBA7 And Win64 Then 'Office 64-bit
Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As LongPtr) As Long
#Else ' Office 32-bit
Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#End If
Nhấp chuột vào đây để mở rộng...

không hiểu . bạn viết đại 1 sub làm ví dụ đi
 
Upvote 0
viehoai đã viết:
Mình đang dùng office 64 bit dùng hàm API thì biến Long ->LongPtr nhưng sao Long cuối (biến trả về của hàm) lại là Long không có Ptr
Nhấp chuột vào đây để mở rộng...

điều này sai !
vì thế tôi mới bảo bạn viết sub cụ thể . không có câu trả lời cho mọi trường hợp
kiểu trả về của hàm findWindow là Long hay LongPtr đều được . nhưng bạn vận dụng không khéo thì lỗi bạn ráng chịu
thí dụ bạn khai báo
findWindow return LongPtr
getMessageW (byval hWnd as LongPtr)

khi sử dụng getMessageW(activeWindow.hWnd,......) thì không sao
nhưng nếu tạo ra 1 biến Long tên là hw (vì viết cho cả 2 HĐH nên phải khai báo hw là Long) thì sai type Missmatch ngay
Mã: 
dim hw as Long
hw = findWindow (....)
call getMessageW (hW,....)

nhưng lại cũng có lúc bắt buộc phải khai báo LongPtr trên máy 64 bit chứ không được là Long
cho nên tôi mới yêu cầu bạn viết sub cụ thể thì tôi mới trả lời được là nên khai báo kiểu nào . không thể nói chung chung được
 
Upvote 0
doveandrose đã viết:
điều này sai !
vì thế tôi mới bảo bạn viết sub cụ thể . không có câu trả lời cho mọi trường hợp
kiểu trả về của hàm findWindow là Long hay LongPtr đều được . nhưng bạn vận dụng không khéo thì lỗi bạn ráng chịu
thí dụ bạn khai báo
findWindow return LongPtr
getMessageW (byval hWnd as LongPtr)

khi sử dụng getMessageW(activeWindow.hWnd,......) thì không sao
nhưng nếu tạo ra 1 biến Long tên là hw (vì viết cho cả 2 HĐH nên phải khai báo hw là Long) thì sai type Missmatch ngay
Mã: 
dim hw as Long
hw = findWindow (....)
call getMessageW (hW,....)

nhưng lại cũng có lúc bắt buộc phải khai báo LongPtr trên máy 64 bit chứ không được là Long
cho nên tôi mới yêu cầu bạn viết sub cụ thể thì tôi mới trả lời được là nên khai báo kiểu nào . không thể nói chung chung được
Nhấp chuột vào đây để mở rộng...
Mình vướng mắc như Bài #5 này nhưng chưa có kết quả vô tình đọc bài của bạn mình thử bỏ Ptr là OK nhưng có thắc mắc khi thì Long, khi thì Long Ptr là sao? có quy luật nào không mong bạn giải thích
Để khhông bị lạc đề topic này, bạn có thể trả lời tiếp link mình đã đưa nhé
Sub cụ thể bài 5 ở trên nhé.
Hay cụ thể hơn là sử dụng hàm này với office - 64 bit <<= Hàm này sửa đi, sửa lại cuối cùng cũng được rồi nhưng không biết lúc nào là Long, lúc nào là LongPtr
Cảm ơn bạn.
 
Lần chỉnh sửa cuối:
Upvote 0
viehoai đã viết:
Mình vướng mắc như Bài #5 này nhưng chưa có kết quả vô tình đọc bài của bạn mình thử bỏ Ptr là OK nhưng có thắc mắc khi thì Long, khi thì Long Ptr là sao? có quy luật nào không mong bạn giải thích
Để khhông bị lạc đề topic này, bạn có thể trả lời tiếp link mình đã đưa nhé
Sub cụ thể bài 5 ở trên nhé.
Hay cụ thể hơn là sử dụng hàm này với office - 64 bit <<= Hàm này sửa đi, sửa lại cuối cùng cũng được rồi nhưng không biết lúc nào là Long, lúc nào là LongPtr
Cảm ơn bạn.
Nhấp chuột vào đây để mở rộng...

í đừng xúi dại . mấy topic bạn nêu ra tôi không thấy có bài viết nào của bạn trong đó thì trả lời làm sao ? vô đó nói nhăng cuội lại xếp vào tội đào bới chủ đề cũ khi không ai có nhu cầu hỏi đáp
đây là cách làm của tôi thôi chứ không có theo sách vở nào hết
tất cả mọi chỗ có kiểu Long từ tham số cho tới kiểu trả về , tôi khai báo cứ để nguyên là Long . khi nào biên dịch nó la làng lên là
Type Missmatch thì vị trí nào báo sai thì vị trí đó sửa lại thành LongPtr
thí dụ chỉ cần sửa lại như vầy là đủ
Mã: 
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
                                            (ByVal idHook As Long, _
                                             ByVal lpfn As Long[COLOR=#ff0000][SIZE=3][B]Ptr[/B][/SIZE][/COLOR], _
                                             ByVal hmod As Long, _
                                             ByVal dwThreadId As Long) As Long

tiếp theo hãy nhìn vào hàm MyUniMsgBox của Hoàng Trọng Nghĩa mà bạn trích dẫn
Mã: 
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
đó chính là cách để tương thích được cả 2 HDH . tại sao vậy ?
hệ 32 bit hàm AddressOf trả về kiểu Long , 64 bit trả về kiểu LongLong
viết thẳng hàm này vào trong hàm SetWindowsHookEx thì ứng với hệ nào nó tự trả về đúng kiểu của hệ đó
còn viết như này là tự bắn vào chân
Mã: 
#If VBA7 Then
  Private Declare PtrSafe Function MessageBoxW Lib "user32" _
  (ByVal hwnd As Long, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal wType As VbMsgBoxStyle) As VbMsgBoxResult
#Else
  Private Declare Function MessageBoxW Lib "user32" _
  (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal wType As VbMsgBoxStyle) As VbMsgBoxResult
#End If
Sub ShowUniMsg()
  Dim text As String, [COLOR=#ff0000][B]textLg As Long[/B][/COLOR]
  text = ChrW(272) & "ây là Msgbox ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t Unicode"
  [COLOR=#ff0000][B]textLg = StrPtr(text)[/B][/COLOR]
  MessageBoxW Application.hwnd,[COLOR=#ff0000][B] textLg,[/B][/COLOR] StrPtr("THÔNG BÁO"), 0
End Sub
cuối cùng bạn sẽ hỏi . vậy nếu tôi có nhu cầu gán giá trị của StrPtr(text) ra 1 biến trung gian để làm việc khác thì sao ?
có 2 cách . 1 cách nguy hiểm : khỏi khai báo biến textLg . cứ thế xài luôn
Mã: 
Sub ShowUniMsg()
  Dim text As String
  text = ChrW(272) & "ây là Msgbox ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t Unicode"
  textLg = StrPtr(text)
  MessageBoxW Application.hwnd, textLg, StrPtr("THÔNG BÁO"), 0
End Sub
nhưng làm vậy thì các nhà thông thái sẽ chỉ trích : chưa khai báo biến textLg mà sử dụng là phản khoa học , blah .. blah
vậy thì khai báo cho vừa ý cả làng
Mã: 
#If VBA7 Then
  Private Declare PtrSafe Function MessageBoxW Lib "user32" _
  (ByVal hwnd As Long, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal wType As VbMsgBoxStyle) As VbMsgBoxResult
  Private textLg As LongPtr
#Else
  Private Declare Function MessageBoxW Lib "user32" _
  (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal wType As VbMsgBoxStyle) As VbMsgBoxResult
  Private textLg As Long
#End If
Sub ShowUniMsg()
  Dim text As String
  text = ChrW(272) & "ây là Msgbox ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t Unicode"
  textLg = StrPtr(text)
  MessageBoxW Application.hwnd, textLg, StrPtr("THÔNG BÁO"), 0
End Sub
 
Upvote 0
doveandrose đã viết:
vừa rồi em có xem bản xla của anh trên FB có chỗ này chưa đúng
Mã: 
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long[COLOR=#ff0000][SIZE=3][B]Ptr[/B][/SIZE][/COLOR]

nó sẽ gây ra lỗi type mismatch ở dòng
Mã: 
hForm = FindWindow("ThunderDFrame", Me.Caption)
anh chỉ cần bỏ chữ Ptr màu đỏ đi là được
Nhấp chuột vào đây để mở rộng...
Thank you bạn! Tôi chơi 1 phát Replace em nào Long thì thành LongPtr và vì không có máy 64bit để kiểm tra nên chẳng biết sai chỗ nào để sửa.

doveandrose đã viết:
tiếp theo là về hiệu ứng . nếu có thể được . em để xuất anh nên tạo ra hiệu ứng khi hơ chuột qua từng ngày . đó có thể là đổi màu ô đó hoặc gì đó tùy . miễn sao người dùng nhận ra là đang rê chuột lên ô nào là được.
Nhấp chuột vào đây để mở rộng...

Cái này không khó, để xem nó phù hợp với màu nào hay hiệu ứng gì nhẹ nhàng thì sẽ thực hiện luôn.

doveandrose đã viết:
cuối cùng là khi click vào các nút hình mũi tên trên Form cảm giác hơi Lag thì phải . hi vọng đây chỉ là cảm giác nhất thời . em không chắc về điều này : xem hàm FixDaysInMonth từ phần
Nhấp chuột vào đây để mở rộng...

Đúng là nó có chớp, nhưng chưa có giải pháp hạn chế.

doveandrose đã viết:
Dim a As String, b As String, c As String, d As String
trở xuống liệu có cần thiết chăng ? hay do em chưa nắm rõ ý nghĩa phần này ?
Nhấp chuột vào đây để mở rộng...

Đúng là hồi đó mình làm trên Label chả có màu gì hết, chỉ màu mặc định nên mình viết cái đó để code tạo màu, sau này mình fill màu sẳn luôn nên code đó thừa, có thể bỏ luôn đoạn đó.
 
Lần chỉnh sửa cuối:
Upvote 0
anh Nghĩa vui lòng cho biết lý do sao ta cần phải sử dụng 2 label cho 1 ngày ( thí dụ lbl11 và AL11)
nếu sử dụng 1 label cho 1 ngày có được không ?
 
Upvote 0
doveandrose đã viết:
anh Nghĩa vui lòng cho biết lý do sao ta cần phải sử dụng 2 label cho 1 ngày ( thí dụ lbl11 và AL11)
nếu sử dụng 1 label cho 1 ngày có được không ?
Nhấp chuột vào đây để mở rộng...
Theo phán đoán của tôi thì 1 cái để hiển thị ngày dương, một cái để hiển thị ngày âm. Dùng một cái cũng được nhưng có lẽ sẽ không đẹp bằng.
 
Lần chỉnh sửa cuối:
Upvote 0
huuthang_bd đã viết:
Theo phán đoán của tôi thì 1 cái để hiển thị ngày dương, một cái để hiển thị ngày dương. Dùng một cái cũng được nhưng có lẽ sẽ không đẹp bằng.
Nhấp chuột vào đây để mở rộng...
tôi hỏi là vì tôi thử set Caption cho hàng loạt label trên Form khác thì thấy có tỉ lệ bị nháy màn hình nhất định nào đó không tránh khỏi .
nếu ở đây ta phải set Caption cho số lượng label giảm đi 1 nửa biết đâu tỉ lệ bị nháy màn hình cũng giảm đi thì tốt hơn
 
Upvote 0
doveandrose đã viết:
tôi hỏi là vì tôi thử set Caption cho hàng loạt label trên Form khác thì thấy có tỉ lệ bị nháy màn hình nhất định nào đó không tránh khỏi .
nếu ở đây ta phải set Caption cho số lượng label giảm đi 1 nửa biết đâu tỉ lệ bị nháy màn hình cũng giảm đi thì tốt hơn
Nhấp chuột vào đây để mở rộng...
Cái này phải chấp nhận đánh đổi thôi. Nếu dùng chung 1 label thì sẽ rất xấu. Thông thường cỡ font chữ ngày âm lịch sẽ nhỏ hơn ngày dương lịch, chưa kể người ta còn tô màu ngày đầu tháng âm lịch để nhận diện nữa. Nếu bạn dùng chung thì format sẽ phải giống nhau hết.
 
Upvote 0
Hỏi xoáy: Đặt con trỏ ngay ô màu vàng, bấm dấu cộng của Group cho nó xổ các hàng ẩn ra, sau đó gọi form xem nó nằm ở đâu? Nếu dung nhan mùa hạ nó nằm tuốt luốt bên dưới, trong trường hợp này mình muốn form nó hiện ra ở đâu cũng được, tức tính làm sao cái Top của nó phải nhỏ hơn cái top của sheet tab thì phải làm sao?
 

File đính kèm

  • Book1.xls
    22.5 KB · Đọc: 38
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Nói tóm lại là cái form nó show lên là được!

Sheet Tab là những cái tab mình bấm chọn sheet đó!
Nhấp chuột vào đây để mở rộng...
ặc . hôm nay mới biết nó kêu là sheet tab =))
làm cho form có nhìn thấy trong sheet thì dễ quá (0,0) cũng là nhìn thấy vậy
anh phải chỉ đích danh hiện chỗ nào mới có hứng làm anh ơi . (chứ như trên là chưa đủ xoáy)
 
Upvote 0
doveandrose đã viết:
ặc . hôm nay mới biết nó kêu là sheet tab =))
làm cho form có nhìn thấy trong sheet thì dễ quá (0,0) cũng là nhìn thấy vậy
anh phải chỉ đích danh hiện chỗ nào mới có hứng làm anh ơi . (chứ như trên là chưa đủ xoáy)
Nhấp chuột vào đây để mở rộng...
Cứ cho là (0, 0) đi, nhưng làm sao biết được nó xảy ra trong trường hợp này?
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Hỏi xoáy: Đặt con trỏ ngay ô màu vàng, bấm dấu cộng của Group cho nó xổ các hàng ẩn ra, sau đó gọi form xem nó nằm ở đâu? Nếu dung nhan mùa hạ nó nằm tuốt luốt bên dưới, trong trường hợp này mình muốn form nó hiện ra ở đâu cũng được, tức tính làm sao cái Top của nó phải nhỏ hơn cái top của sheet tab thì phải làm sao?
Nhấp chuột vào đây để mở rộng...
Đề phòng cho trường hợp không bao giờ xảy ra --=0
Mã: 
Public Function CellPosition(ByVal rCell As Range) As Variant
    Dim arrLeftTop(1 To 2) As Double, r As Byte
    Set rCell = ActiveCell
    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
                    arrLeftTop(1) = .Panes(r).PointsToScreenPixelsX(rCell.Left) * 0.75
                    arrLeftTop(2) = .Panes(r).PointsToScreenPixelsY(rCell.Top) * 0.75 + rCell.Height
                    Exit For
                End If
            Next
        Else
            arrLeftTop(1) = .ActivePane.PointsToScreenPixelsX(rCell.Left) * 0.75
            arrLeftTop(2) = .ActivePane.PointsToScreenPixelsY(rCell.Top) * 0.75 + rCell.Height
        End If
    End With
[COLOR=#0000cd]    Dim TmpCll As Range[/COLOR]
[COLOR=#0000cd]    On Error Resume Next
    Set TmpCll = ActiveWindow.RangeFromPoint(arrLeftTop(1) / 0.75, (arrLeftTop(2) - rCell.Height) / 0.75)
    On Error GoTo 0
    If TmpCll Is Nothing Then
        arrLeftTop(1) = 0
        arrLeftTop(2) = 0
    End If[/COLOR]
    CellPosition = arrLeftTop
End Function
 
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

Tuấn Bụng Bự
  • Question
Hiển thị UserForm theo vị trí ô cell được chọn
Trả lời
0
Đọc
3
Tuấn Bụng Bự
Tuấn Bụng Bự
LuuAnh980
Vấn đề viết tắt trong Diễn Đàn.
    • Thích
    • Cười
2 3
Trả lời
55
Đọc
1K
VetMini
V
V
  • Question
GIúp code xóa các tên mặt hàng trùng nhau, chỉ chừa lại tên cho dòng trên cùng
Trả lời
14
Đọc
409
Văn Toàn 1996
V
solomon2211
PDF Tools giúp ghép, tách, xóa file pdf
    • Thích
    • Yêu thích
Trả lời
15
Đọc
279
cantl
C
T
xin công thức tính kết chuyển lỗ vào thu nhập tính thuế TNDN trong nhiều năm
Trả lời
1
Đọc
67
HieuCD
H
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