Hiển thị UserForm theo vị trí ô cell được chọn

[Tuấn Bụng Bự]

Xin chào các bác !
Em đang gặp khó khăn trong việc xác định tọa độ của ô cell trên màn hình máy tính để cho hiển thị userform bên cạnh nó
em có thực hiện code như dưới nhưng nó hiển thị không đúng, (em nghĩ là do em chưa xác định được tọa độ màn hình):
mong các bác cho em xin đoạn code xử lý vấn đề trên ạ!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column > 3 And Target.Column Mod 2 = 0 Then
Cancel = True

With F_selectMoney
.StartUpPosition = 0
.Top = Target.Top
.Left = Target.Left
.Show
End With
End If
End Sub


trong file excel có đặt Freeze panes tại vị trí D7 , khi kéo thanh ngang thì cái userform nó còn mất hút luôn ạ

 

[Mr.hieudoanxd]

Hi vọng đúng ý bác!. Không rành về API lắm làm theo ý "hơi hiểu thôi"

 

[huhumalu]

Hi vọng đúng ý bác!. Không rành về API lắm làm theo ý "hơi hiểu thôi"

Xịn xò rồi;
Chỉ góp ý thêm vụ bổ sung "enter" để nhập liệu;

Private Sub Money_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    ' Enter key 32; Space key 13
    If KeyCode = 13 Or KeyCode = 32 Then
        ActiveCell.Value = Me.Money.Value
        Unload Me
    End If
End Sub

 

[Tuấn Bụng Bự]

Hi vọng đúng ý bác!. Không rành về API lắm làm theo ý "hơi hiểu thôi"

Xin chân thành cảm ơn Bac HieuDoan !
code của bác em đã test hiển thị đúng yêu cầu theo activecell rồi.
Nếu có thể mong bác khai sáng cho em về đoạn code dưới , em chỉ hiểu được độc 1 dòng if cho win 64 bít và dưới là win 32bit mà thôi

#If Win64 And VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long

Dim hDc As LongPtr
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long

Dim hDc As Long
#End If

Type POINTAPI
X As Long
Y As Long
End Type

Bài đã được tự động gộp: 21/5/24

Xịn xò rồi;
Chỉ góp ý thêm vụ bổ sung "enter" để nhập liệu;

Private Sub Money_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    ' Enter key 32; Space key 13
    If KeyCode = 13 Or KeyCode = 32 Then
        ActiveCell.Value = Me.Money.Value
        Unload Me
    End If
End Sub

thanks bác!
thêm lựa chọn phím enter cũng hay bác ạ

 

[Mr.hieudoanxd]

Nếu có thể mong bác khai sáng cho em về đoạn code dưới , em chỉ hiểu được độc 1 dòng if cho win 64 bít và dưới là win 32bit mà thôi

Theo em, bác nên đọc và tìm hiểu về API cụ thể ở đây là handle. Đoạn code #if...#then...#end if trên là để khai báo 3 hàm GetDC, GetDeviceCaps, ReleaseDC. Sau khi 3 hàm đó được khai báo như trên sẽ được sử dụng ở code phía dưới. Chi tiết ý nghĩa của 3 hàm đó lần lượt như sau:

- Hàm GetDC lấy một handle đến device context ( ở đây đặt biến là hDC)
- Hàm GetDeviceCaps truy vấn các thông số kỹ thuật của device context, như độ phân giải màn hình, số lượng màu sắc hỗ trợ, v.v.
- Hàm ReleaseDC giải phóng handle sau khi đã thực hiện các thao tác ở trên

Nói để bác biết thế thôi chứ thời điểm hiện tại của bác (theo em đoán) cũng giống em khi mới bập bõm VBA, nói thêm cũng không có tác dụng gì. Tốt nhất nên học thêm nhiều bác nhé!

 

[Tuấn Bụng Bự]

Chào các bác, lại là em Gà đây
trước hết em muốn chia sẻ Calendar picker mà em sưu tầm của bác Trevor Eyre có hiệu ứng rất đẹp.
thứ 2 là em muốn làm phiền các bác chỉ giáo giúp em cách kết hợp nó với code lấy vị trí hiển thị userform của bác Mr.hieudoanxd với ạ

1.............Code bác Mr.Hieu Doan

#If Win64 And VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long

Dim hDc As LongPtr
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long

Dim hDc As Long
#End If

Type POINTAPI
X As Long
Y As Long
End Type


Sub SetUpForm(ctrlForm As Object, Rng As Range)
With ctrlForm
.startupposition = 0
'.Height = 18
.Left = TopLeftPoint(Rng).X + 90
.Top = TopLeftPoint(Rng).Y + 90 '+ Rng.Height
End With
End Sub


Private Function TopLeftPoint(ByVal Alan As Range) As POINTAPI
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
Const PointsPerInch = 72
Dim PixelsPerPointX As Double
Dim PixelsPerPointY As Double
Dim PointsPerPixelX As Double
Dim PointsPerPixelY As Double
hDc = GetDC(0)
PixelsPerPointX = GetDeviceCaps(hDc, LOGPIXELSX) / PointsPerInch
PointsPerPixelX = PointsPerInch / GetDeviceCaps(hDc, LOGPIXELSX)
PixelsPerPointY = GetDeviceCaps(hDc, LOGPIXELSY) / PointsPerInch
PointsPerPixelY = PointsPerInch / GetDeviceCaps(hDc, LOGPIXELSY)
With TopLeftPoint
.X = ActiveWindow.PointsToScreenPixelsX(Alan.Left * (PixelsPerPointX * (ActiveWindow.Zoom / 100))) * PointsPerPixelX
.Y = ActiveWindow.PointsToScreenPixelsY(Alan.Top * (PixelsPerPointY * (ActiveWindow.Zoom / 100))) * PointsPerPixelY
End With
ReleaseDC 0, hDc
End Function



2....... code gọi Calendar picker

Sub AdvancedCalendar2()

Dim dateVariable

SetUpForm CalendarForm, Selection 'Đây là phần em thêm nhưng nó không điều chỉnh được vị trí hiển thị đúng

dateVariable = CalendarForm.GetDate( _
SelectedDate:=Date, _
DateFontSize:=11, _
TodayButton:=True, _
BackgroundColor:=RGB(242, 248, 238), _
HeaderColor:=RGB(84, 130, 53), _
HeaderFontColor:=RGB(255, 255, 255), _
SubHeaderColor:=RGB(226, 239, 218), _
SubHeaderFontColor:=RGB(55, 86, 35), _
DateColor:=RGB(242, 248, 238), _
DateFontColor:=RGB(55, 86, 35), _
SaturdayFontColor:=RGB(55, 86, 35), _
SundayFontColor:=RGB(55, 86, 35), _
TrailingMonthFontColor:=RGB(106, 163, 67), _
DateHoverColor:=RGB(198, 224, 180), _
DateSelectedColor:=RGB(169, 208, 142), _
TodayFontColor:=RGB(255, 0, 0), _
DateSpecialEffect:=fmSpecialEffectRaised)

If dateVariable <> 0 Then ActiveCell = dateVariable
End Sub

 

[Mr.hieudoanxd]

trước hết em muốn chia sẻ Calendar picker mà em sưu tầm của bác Trevor Eyre có hiệu ứng rất đẹp.
thứ 2 là em muốn làm phiền các bác chỉ giáo giúp em cách kết hợp nó với code lấy vị trí hiển thị userform của bác Mr.hieudoanxd với ạ

Thật ra code đã setup đến vị trí activecell bằng hàm của em rồi nhưng sau đó lại setup lại ở sub InitializeUserform trong Useform. Để code chạy đúng ý bác tìm đến đoạn sau xóa đi hoặc chuyển về dạng comment (Như bài đính kèm):

    If PositionTop <> -5 And PositionLeft <> -5 Then
        Me.startupposition = 0
        Me.Top = PositionTop
        Me.Left = PositionLeft
    Else
        Me.startupposition = 1
    End If

Bác tìm trên diễn đàn hoặc trên mạng bài viết về Useform để biết rõ hơn về vấn đề này
Ghi chú 1: Code sưu tầm nền comment nhiều quá rối mắt
Ghi chú 2: Form Calendar xấu òm.

 

[Tuấn Bụng Bự]

Thật ra code đã setup đến vị trí activecell bằng hàm của em rồi nhưng sau đó lại setup lại ở sub InitializeUserform trong Useform. Để code chạy đúng ý bác tìm đến đoạn sau xóa đi hoặc chuyển về dạng comment (Như bài đính kèm):

    If PositionTop <> -5 And PositionLeft <> -5 Then
        Me.startupposition = 0
        Me.Top = PositionTop
        Me.Left = PositionLeft
    Else
        Me.startupposition = 1
    End If

Bác tìm trên diễn đàn hoặc trên mạng bài viết về Useform để biết rõ hơn về vấn đề này
Ghi chú 1: Code sưu tầm nền comment nhiều quá rối mắt
Ghi chú 2: Form Calendar xấu òm.

Hình như bác nhầm calendar rồi, hình nó đây cơ mà, nó có hiệu ứng chỗ con chuột di đến ngày nào thì đổi màu.
cái hay của code này nữa là cả 1 đống code bên trong tuy em chẳng hiểu nhưng nguyên cái sub AdvancedCalendar2 mình chỉ đổi màu RGB là nó ra hết hiệu ứng mình muốn ạ.
p/s : bác có cái calendar nào hay mà để riêng 1 sub tùy chỉnh được màu hiệu ứng + vị trí hiển thị share em với

 

[Mr.hieudoanxd]

p/s : bác có cái calendar nào hay mà để riêng 1 sub tùy chỉnh được màu hiệu ứng + vị trí hiển thị share em vớiView attachment 301096

Thì em đang nói cái form này xấu òm mà.

 

[hoangtuan.net]

Cảm ơn bác, chủ đề rất hay. Tuy nhiên bác nên cho mã vào thẻ code cho dễ nhìn hơn ạ!