- Tham gia
- 30/5/06
- Bài viết
- 1,630
- Được thích
- 17,442
- Nghề nghiệp
- Bác sĩ
Lê Văn Duyệt
Vâng, thưa các bạn có những lúc các bạn muốn form người dùng hiện ra tại một vị trí, hay một ô nào bạn muốn. Thế thì làm sao chúng ta có thể làm được vậy?
Chúng ta hãy cùng đọc bài FormPosition trên trang Web cpearson.
Đầu tiên chúng ta hãy chép module vào file Excel của chúng ta:
modFormPositioner module
Option Explicit
Option Compare Text


' Module Name: modFormPositioner
' Date: 22-Sept-2002
' Author: Chip Pearson, www.cpearson.com, chip@cpearson.com
' Copyright: (c) Copyright 2002, Charles H Pearson.
'
' Description: Calculates to position to display
' a userform relative to a cell.
'
' Usage:
' Declare a variable of type Positions:
' Dim PS As Positions
' Call the PositionForm function, passing it the following
' parameters:
' WhatForm The userform object
'
' AnchorRange The cell relative to which the form
' should be displayed.
'
' NudgeRight Optional: Number of points to nudge the
' for to the right. This is useful with
' bordered range. Typically, this should
' be 0, but may be positive or negative.
'
' NudgeDown Optional: Number of points to nudge the
' for downward. This is useful with
' bordered range. Typically, this should
' be 0, but may be positive or negative.
'
' HorizOrientation: Optional: One of the following values:
' cstFhpNull = Left of screen
' cstFhpAppCenter = Center of Excel screen
' cstFhpAuto = Automatic (recommended and default)
'
' cstFhpFormLeftCellLeft = left edge of form at left edge of cell
' cstFhpFormLeftCellRight = left edge of form at right edge of cell
' cstFhpFormLeftCellCenter = left edge of form at center of cell
'
' cstFhpFormRightCellLeft = right edge of form at left edge of cell
' cstFhpFormRightCellRight = right edge of form at right edge of cell
' cstFhpFormRightCellCenter = right edge of form at center of cell
'
' cstFhpFormCenterCellLeft = center of form at left edge of cell
' cstFhpFormCenterCellRight = center of form at right edge of cell
' cstFhpFormCenterCellCenter = center of form at center of cell
'
' VertOrientation Optional: One of the following values:
'
' cstFvpNull = Top of screen
' cstFvpAppCenter = Center of Excel screen
' cstFvpAuto = Automatic (recommended and default)
'
' cstFvpFormTopCellTop = top edge of form at top edge of cell
' cstFvpFormTopCellBottom = top edge of form at bottom edge of cell
' cstFvpFormTopCellCenter = top edge of form at center of cell
'
' cstFvpFormBottomCellTop = bottom edge of form at top of edge of cell
' cstFvpFormBottomCellBottom = bottom edge of form at bottom edge of cell
' cstFvpFormBottomCellCenter = bottom edge of form at center of cell
'
' cstFvpFormCenterCellTop = center of form at top of cell
' cstFvpFormCenterCellBottom = center of form at bottom of cell
' cstFvpFormCenterCellCenter = center of form at center of cell
'
' For example:
' PS = PositionForm (UserForm1,Range("C12"),0,0,cstFvpAuto,cstFhpAuto)
'
' Then, position the form using the values from PS:
' UserForm1.Top = PS.FrmTop
' UserForm1.Left = PS.FrmLeft
' Finally, show the form:
' UserForm1.Show vbModal
'
' In summary, the code would look like
'
' Dim PS As Positions
' PS = PositionForm (UserForm1,ActiveCell,0,0,cstFvpAuto,cstFhpAuto)
' UserForm1.Top = PS.FrmTop
' UserForm1.Left = PS.FrmLeft
' UserForm1.Show vbModal
'
'
'




' Type: Positions
'
' We store everything in a structure so that we can easily
' pass things around from on procedure to another. Otherwise,
' we'd quickly run out of stack space passing to the
' optimazation procedures.
'


Public Type Positions
FrmTop As Single ' Userform
FrmLeft As Single
FrmHeight As Single
FrmWidth As Single
RngTop As Single ' Passed in cell
RngLeft As Single
RngWidth As Single
RngHeight As Single
AppTop As Single 'Application
AppLeft As Single
AppWidth As Single
AppHeight As Single
WinTop As Single ' Window
WinLeft As Single
WinWidth As Single
WinHeight As Single
Cell1Top As Single ' 1st cell in visible range
Cell1Left As Single
Cell1Width As Single
Cell1Height As Single
LastCellTop As Single ' last visible cell in window
LastCellLeft As Single
LastCellWidth As Single
LastCellHeight As Single
BaseLeft As Single ' the are the screen based coordinates for the upper left corner
BaseTop As Single ' of cell.
VComp As Single ' compensations for displayed object (toolbars, headers, etc)
HComp As Single
NudgeDown As Single ' allow the user to nudge the positioning by a few pixels.
NudgeRight As Single
#If VBA6 Then
OrientationH As cstFormHorizontalPosition
OrientationV As cstFormVerticalPosition
#Else
OrientationH As Long
OrientationV As Long
#End If
End Type


' End TYPE


#If VBA6 Then
Public Enum cstFormHorizontalPosition
cstFhpNull = -2 ' X = 0, left of screen
cstFhpAppCenter = -1
cstFhpAuto = 0
cstFhpFormLeftCellLeft
cstFhpFormLeftCellRight
cstFhpFormLeftCellCenter
cstFhpFormRightCellLeft
cstFhpFormRightCellRight
cstFhpFormRightCellCenter
cstFhpFormCenterCellLeft
cstFhpFormCenterCellRight
cstFhpFormCenterCellCenter
End Enum
Public Enum cstFormVerticalPosition
cstFvpNull = -2 ' Y = 0, top of screen
cstFvpAppCenter = -1
cstFvpAuto = 0
cstFvpFormTopCellTop
cstFvpFormTopCellBottom
cstFvpFormTopCellCenter
cstFvpFormBottomCellTop
cstFvpFormBottomCellBottom
cstFvpFormBottomCellCenter
cstFvpFormCenterCellTop
cstFvpFormCenterCellBottom
cstFvpFormCenterCellCenter
End Enum
#Else
Public Const cstFhpNull As Long = -2 ' X = 0, left of screen
Public Const cstFhpAppCenter As Long = -1
Public Const cstFhpAuto As Long = 0
Public Const cstFhpFormLeftCellLeft As Long = 1
Public Const cstFhpFormLeftCellRight As Long = 2
Public Const cstFhpFormLeftCellCenter As Long = 3
Public Const cstFhpFormRightCellLeft As Long = 4
Public Const cstFhpFormRightCellRight As Long = 5
Public Const cstFhpFormRightCellCenter As Long = 6
Public Const cstFhpFormCenterCellLeft As Long = 7
Public Const cstFhpFormCenterCellRight As Long = 8
Public Const cstFhpFormCenterCellCenter As Long = 9
Public Const cstFvpNull As Long = -2 ' Y = 0, top of screen
Public Const cstFvpAppCenter As Long = -1
Public Const cstFvpAuto As Long = 0
Public Const cstFvpFormTopCellTop As Long = 1
Public Const cstFvpFormTopCellBottom As Long = 2
Public Const cstFvpFormTopCellCenter As Long = 3
Public Const cstFvpFormBottomCellTop As Long = 4
Public Const cstFvpFormBottomCellBottom As Long = 5
Public Const cstFvpFormBottomCellCenter As Long = 6
Public Const cstFvpFormCenterCellTop As Long = 7
Public Const cstFvpFormCenterCellBottom As Long = 8
Public Const cstFvpFormCenterCellCenter As Long = 9
#End If