Question

Excel2003 VBA：如何在运行时将窗体居中？

根据程序要求，窗体的高度是不同的。那针对不同的高度，如何使窗体总是自动居中呢？
网上有：Form1.Top = Screen.Height / 2 - Form1.Height / 2。可是总提示Screen有问题。
StartUpPosition又是在设计时使用的属性。
真不知如何解决了。
谢谢各位。

Answer 1

以下代码可完美解决你的问题，其中，根据的窗体改下Userform1
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetSystemMetrics Lib "user32 " (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOZORDER = &H4
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOSIZE = &H1
Private Sub UserForm_Activate()
Dim x As Long, y As Long
x = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)
Dim hw As Long
hw = FindWindow(vbNullString, "Userform1")'此处的Userform1是你窗体的Caption
If hw <> 0 Then SetWindowPos hw, HWND_NOTOPMOST, (x - UserForm1.Width) / 2, (y - UserForm1.Height) / 2, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_SHOWWINDOW
End Sub‘此处的Userform1是你的窗体名称

Answer 2

=========================================================================
在窗体上添加一个ScrollBar1滚动条，输入以下代码：

Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowPos& Lib "user32" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal x&, ByVal y&, ByVal cx&, ByVal cy&, ByVal wFlags&)
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Dim cx As Integer, cy As Integer

Private Sub ScrollBar1_Change()
xFactor = Me.ScrollBar1
Me.Zoom = Me.ScrollBar1
Me.Width = 150 * (Me.ScrollBar1 / 100)
Me.Height = 130 * (Me.ScrollBar1 / 100)
middle
Me.Repaint
End Sub

Sub middle()
Const SWP_NOSIZE& = &H1
Dim iWidth As Integer
Dim iHeight As Integer
Dim iLeft As Integer
Dim iTop As Integer
Dim Size As RECT
cx = GetSystemMetrics32(SM_CXSCREEN)
cy = GetSystemMetrics32(SM_CYSCREEN)
hWnd = FindWindow("ThunderDFrame", Me.Caption) 'UserForm
GetWindowRect hWnd, Size
iWidth = Abs(Size.Right - Size.Left)
iHeight = Abs(Size.Top - Size.Bottom)
iLeft = (cx - iWidth) / 2
iTop = (cy - iHeight) / 2
SetWindowPos hWnd, 0&, iLeft, iTop, 0&, 0&, SWP_NOSIZE
End Sub

Private Sub UserForm_Initialize()
Me.ScrollBar1 = 100
Me.ScrollBar1.LargeChange = 10
Me.ScrollBar1.Max = 250
Me.ScrollBar1.Min = 90
End Sub

Answer 3

StartUpPosition又是在设计时使用的属性。
注意这只是在 VB 中，但在 Excel2003 VBA 支持于运行中设置。
下面是一个简单例子。

添加用户窗体 UserForm1 ，设置 StartUpPosition 的缺省值为0。
在 Sheet1 中加入下列代码。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
UserForm1.Height = 309
UserForm1.StartUpPosition = 2
UserForm1.Show
End Sub