- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,717
- Giới tính
- Nam
Trong phiên bản 7 này, tôi đã cập nhật tính năng định vị CALENDAR sẽ hiển thị dưới các TextBox chứa trong UserForm, Frame/MultiPage.
Các phiên bản trước chỉ xác định đúng khi TextBox chỉ chứa trong UserForm, nhưng một số chương trình lại đặt TextBox lấy ngày tháng đó trong một hay nhiều Frame hoặc/và Multipage thì Calendar không xác định chính xác Top & Left của nó so với TextBox. Và lần này cũng bổ sung, nếu cái TextBox sát màn hình Window, nó sẽ dịch chuyển lên trên hoặc qua trái.
Cấu trúc của việc nhúng lịch cũng dễ dàng hơn và đơn giản hơn.
1) Trên Sheet:
1.1) Thủ tục:
1.2) Nhúng trên CELL:
1.3) Nhúng trên ActiveX Controls:
2) Trên UserForm:
2.1) Thủ tục:
Trong thủ tục này, tôi đặc biệt cám ơn bạn doveandrose đã giúp tôi xác định InsideHeight của MultiPage và bạn jack nt đã giúp tôi xác định FullName của một Control.
2.2) Control trong UserForm, thủ tục như sau:
Các phiên bản trước chỉ xác định đúng khi TextBox chỉ chứa trong UserForm, nhưng một số chương trình lại đặt TextBox lấy ngày tháng đó trong một hay nhiều Frame hoặc/và Multipage thì Calendar không xác định chính xác Top & Left của nó so với TextBox. Và lần này cũng bổ sung, nếu cái TextBox sát màn hình Window, nó sẽ dịch chuyển lên trên hoặc qua trái.
Cấu trúc của việc nhúng lịch cũng dễ dàng hơn và đơn giản hơn.
1) Trên Sheet:
1.1) Thủ tục:
Mã:
Public Sub CalendarOnSheet(ByVal RangeOrObject As Object)
pubShowModal = False
pubIsRange = (TypeName(RangeOrObject) = "Range")
Set pubDateObject = RangeOrObject
On Error Resume Next
Dim myArr
Dim myLeft As Single, myTop As Single
myArr = CellOrControlPosition(RangeOrObject)
If IsArray(myArr) Then
myLeft = myArr(1)
myTop = myArr(2)
With Application
If myLeft + usfCalendar.Width > .Left + .Width Then
myLeft = myLeft - usfCalendar.Width
If TypeName(RangeOrObject) = "Range" Then
myLeft = myLeft + RangeOrObject.Width * ActiveWindow.Zoom / 100
End If
End If
If myTop + usfCalendar.Height > .Top + .Height Then
myTop = myTop - usfCalendar.Height - RangeOrObject.Height * ActiveWindow.Zoom / 100
End If
End With
If Not pubIsRange Then
ActiveCell.Select
End If
End If
DatePicked RangeOrObject.Value
With usfCalendar
.StartUpPosition = 0
.Left = myLeft
.Top = myTop
.Show False
End With
End Sub1.2) Nhúng trên CELL:
Mã:
Run "CalendarShow_V.7.xla!CalendarOnSheet", Range("C5")
Run "CalendarShow_V.7.xla!CalendarOnSheet", Target
Run "CalendarShow_V.7.xla!CalendarOnSheet", ActiveCell1.3) Nhúng trên ActiveX Controls:
Mã:
Run "CalendarShow_V.7.xla!CalendarOnSheet", TextBox1
Run "CalendarShow_V.7.xla!CalendarOnSheet", ComboBox12) Trên UserForm:
2.1) Thủ tục:
Trong thủ tục này, tôi đặc biệt cám ơn bạn doveandrose đã giúp tôi xác định InsideHeight của MultiPage và bạn jack nt đã giúp tôi xác định FullName của một Control.
PHP:
Public Sub CalendarOnForm(ByVal DateObject As Object, ByVal UserForm As Object)
pubShowModal = True
Set pubDateObject = DateObject
On Error Resume Next
Dim Ctrl As Control
Dim myEdge As Single, myLeft As Single, myTop As Single
With UserForm
myEdge = (.Width - .InsideWidth) / 2
myLeft = .Left + myEdge
myTop = .Top + .Height - .InsideHeight - myEdge
End With
Set Ctrl = DateObject
Do Until Ctrl.Parent.Name = UserForm.Name
Set Ctrl = Ctrl.Parent
If Not Ctrl.Name Like "Page*" Then
Select Case TypeName(Ctrl)
Case "Frame"
With Ctrl
myEdge = (.Width - .InsideWidth) / 2
myLeft = myLeft + .Left + myEdge
myTop = myTop + .Top + .Height - .InsideHeight - myEdge
End With
Case "MultiPage"
With Ctrl
myEdge = (.Width - .Pages(0).InsideWidth) / 2
myLeft = myLeft + .Left + myEdge
myTop = myTop + .Top + .Height - .Pages(0).InsideHeight - myEdge
End With
End Select
End If
Loop
With DateObject
myLeft = myLeft + .Left
myTop = myTop + .Top + .Height
DatePicked .Value
End With
With Application
If myLeft + usfCalendar.Width > .Left + .Width Then
myLeft = myLeft - usfCalendar.Width
End If
If myTop + usfCalendar.Height > .Top + .Height Then
myTop = myTop - usfCalendar.Height - DateObject.Height
End If
End With
With usfCalendar
.StartUpPosition = 0
.Left = myLeft
.Top = myTop
.Show
End With
End Sub2.2) Control trong UserForm, thủ tục như sau:
Mã:
Run "CalendarShow_V.7.xla!CalendarOnForm", TextBox1, Me
Run "CalendarShow_V.7.xla!CalendarOnForm", ComboBox1, UserForm1
Lần chỉnh sửa cuối:
