Access开发者手册中的窗体自动适应大小的代码，营养丰富

tmtony

Access开发者手册中的窗体自动适应屏幕大小（窗体及窗体里的控件自动适应伸缩）的代码，营养丰富，使用了API，是Access代码中的经典，有兴趣的网友，可深入研究一下。
Option Compare Database 'Use database order for string comparisons
Option Explicit


' From Microsoft Access 95 Developer's Handbook
' by Litwin, Getz, Gilbert, and Reddick (Sybex)
' Copyright 1995. All rights reserved.


' Store rectangle coordinates.
Type glrTypeRect
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long
End Type


Declare Function glr_apiIsIconic Lib "user32" _
Alias "IsIconic" (ByVal hwnd As Long) As Long


Declare Function glr_apiGetDeviceCaps Lib "gdi32" _
Alias "GetDeviceCaps" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long


Declare Function glr_apiGetWindowRect Lib "user32" _
Alias "GetWindowRect" (ByVal hwnd As Long, _
lpRect As glrTypeRect) As Long


Declare Function glr_apiGetParent Lib "user32" _
Alias "GetParent" (ByVal hwnd As Long) As Long


Declare Function glr_apiGetClientRect Lib "user32" _
Alias "GetClientRect" (ByVal hwnd As Long, _
lpRect As glrTypeRect) As Long


Declare Function glr_apiGetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long


Declare Function glr_apiGetSystemMetrics Lib "user32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long


Declare Function glr_apiGetSystemMenu Lib "user32" _
Alias "GetSystemMenu" (ByVal hwnd As Long, _
ByVal bRevert As Long) As Long


Declare Function glr_apiGetActiveWindow Lib "user32" _
Alias "GetActiveWindow" () As Long






'================================================= ======================


' Store group/subform dimensions.
Type glrTypeDimensions
sglLeft As Single
sglTop As Single
sglWidth As Single
sglHeight As Single
strCtlName As String
End Type

tmtony

' These are the class names used in Access.
Public Const glrcAccessClass = "OMain"
Public Const glrcMDIClientClass = "MDICLIENT"
Public Const glrcAccessDBCClass = "ODb"
Public Const glrcAccessFormClass = "OForm"

' Windows API declarations.
Declare Function glr_apiCreateIC Lib "gdi32" _
Alias "CreateICA" (ByVal lpDriverName As String, _
ByVal lpDeviceName As String, ByVal lpOutput As String, _
lpInitData As Any) As Long

Declare Function glr_apiDeleteDC Lib "gdi32" _
Alias "DeleteDC" (ByVal hdc As Long) As Long

Declare Function glr_apiMoveWindow Lib "user32" _
Alias "MoveWindow" (ByVal hwnd As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Declare Function glr_apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function glr_apiEnableMenuItem Lib "user32" _
Alias "EnableMenuItem" (ByVal hMenu As Long, _
ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long

Declare Function glr_apiGetWindow Lib "user32" _
Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Declare Function glr_apiGetClassName Lib "user32" _
Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Declare Function glr_apiFindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare Function glr_apiGetNextWindow Lib "user32" _
Alias "GetNextWindow" (ByVal hwnd As Long, _
ByVal wFlag As Long) As Long

Declare Function glr_apiSetFocus Lib "user32" _
Alias "SetFocus" (ByVal hwnd As Long) As Long

' Get a string from a private INI file. Returns the number of bytes
' copied into strReturned, not including the trailing null.
Declare Function glr_apiGetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long

' Write a string to a private INI file. Returns a non-zero value if
successful,
' otherwise it returns a 0.

Declare Function glr_apiWritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As
String) As Long

' These functions aren't actually used
' but are provided here for reference only.

' Get a string from WIN.INI. Returns the number of bytes copied into
strReturned,
' not including the trailing null.
Declare Function glr_apiGetProfileString Lib "kernel32" _
Alias "GetProfileStringA" (ByVal lpglrcAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As Long

' Get an integer from WIN.INI. Returns either the integer it found,
' or the value sent in intDefault.
Declare Function glr_apiGetProfileInt Lib "kernel32" _
Alias "GetProfileIntA" (ByVal lpglrcAppName As String, _
ByVal lpKeyName As String, ByVal nDefault As Long) As Long

' Write a string to WIN.INI. Returns a non-zero value if successful,
' otherwise it returns a 0.
Declare Function WriteProfileString Lib "kernel32" _
Alias "WriteProfileStringA" (ByVal lpszSection As String, _
ByVal lpszKeyName As String, ByVal lpszString As String) As Long

' Get an integer from a private INI file. Returns either the integer it
found,
' or the value sent in intDefault.
Declare Function GetPrivateProfileInt Lib "kernel32" _
Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal nDefault As Long, _
ByVal lpFileName As String) As Long

' GetNextWindow() constants
Public Const glrcGW_CHILD = 5
Public Const glrcGW_HWNDNEXT = 2

' Action constants
Public Const glrcMF_BYCOMMAND = &H0
Public Const glrcMF_DISABLED = &H2
Public Const glrcMF_ENABLED = &H0
Public Const glrcMF_GRAYED = &H1

' Menu item name constants
Public Const glrcSC_SIZE = &HF000
Public Const glrcSC_MOVE = &HF010
Public Const glrcSC_MINIMIZE = &HF020
Public Const glrcSC_MAXIMIZE = &HF030
Public Const glrcSC_NEXTWINDOW = &HF040
Public Const glrcSC_CLOSE = &HF060
Public Const glrcSC_RESTORE = &HF120

' Windows API Constants
Public Const glrcVERTRES = 10
Public Const glrcHORZRES = 8
Public Const glrcLOGPIXELSX = 88
Public Const glrcLOGPIXELSY = 90

' General Constants
Public Const glrcTwipsPerInch = 1440

' GetWindowLong Constant
Public Const glrcGWL_STYLE = -16

' Windows Style constant
Public Const glrcWS_CAPTION = &HC00000

' System Metrics Constant
Public Const glrcSM_CYCAPTION = 4
Public Const glrcSM_CXFULLSCREEN = 16
Public Const glrcSM_CYFULLSCREEN = 17

Function IsSubForm(frm As Form) As Boolean
' Is the form referenced in the
' parameter currently loaded as a subform?
' Check its Parent property to find out.

' From Microsoft Access 95 Developer's Handbook
' by Litwin, Getz, Gilbert, and Reddick (Sybex)
' Copyright 1995. All rights reserved.

' In:
' frm: a reference to the form in question
' Out:
' Return value: True if the form is a subform
' False if it's a standalone form
Dim strName As String
On Error Resume Next
strName = frm.Parent.name
IsSubForm = (Err = 0)
On Error GoTo 0
End Function

tmtony

Option Compare Database 'Use database order for string comparisons
Option Explicit

' From Microsoft Access 95 Developer's Handbook
' by Litwin, Getz, Gilbert, and Reddick (Sybex)
' Copyright 1995. All rights reserved.

' Constants that aren't there, that probably should be.
Const acWindow = 7
Const acSizeToFit = 6
Const acDatasheetView = 2

' Enumerated constants for GetTwips()
Const glrcXAxis = 0
Const glrcYAxis = 1

' The maximum size for a form is 22 inches.
Const glrcMaxTwips = 22 * glrcTwipsPerInch

' These constants should not require changing.
' 1280x1024, 1024x768 use 12 and 12.
' 640x480 and 800x600 use 15 and 15.
'
Const glrcDesignXTwipsLoRes = 15
Const glrcDesignYTwipsLoRes = 15
Const glrcDesignXTwipsHiRes = 12
Const glrcDesignYTwipsHiRes = 12

' Keep track of the previous/original size for the form.
' Dim rctOriginal As glrTypeRect

' Error constants
Const glrcErrDivisionByZero = 11
Const glrcErrInvalidProperty = 2455

Private Function ChangeFont(Ctl As Control) As Boolean

' Decide whether or not to change the font,
' based on the control type.

Dim fDoit As Integer
fDoit = False
Select Case Ctl.ControlType
Case acTextBox, acComboBox, acListBox, acLabel, _
acCommandButton, acToggleButton
fDoit = True
Case Else
fDoit = False
End Select
ChangeFont = fDoit
End Function

Private Function ChangeHeight(Ctl As Control) As Boolean

' Decide whether or not to change the height,
' based on the control type.

Dim fDoit As Integer
fDoit = True
Select Case Ctl.ControlType
Case acCheckBox, acOptionButton, acPageBreak, acPage
fDoit = False
Case Else
fDoit = True
End Select
ChangeHeight = fDoit
End Function

Private Function FixGroups(frm As Form, aGroups() As glrTypeDimensions,
sglFactorX As Single, sglFactorY As Single)

' Store away information about controls that
' contain other controls (subforms/subgroups).
' Return the number of these controls that
' were found.

Dim intI As Integer
Dim fDoit As Boolean
Dim intGroups As Integer

intGroups = 0
For intI = 0 To frm.Count - 1
With frm(intI)
Select Case .ControlType
Case acOptionGroup, acSubform
fDoit = True
Case Else
fDoit = False
End Select
If fDoit Then
intGroups = intGroups + 1
ReDim Preserve aGroups(intGroups)

aGroups(intGroups).strCtlName = .name
aGroups(intGroups).sglLeft = .Left * sglFactorX
aGroups(intGroups).sglTop = .Top * sglFactorY
aGroups(intGroups).sglWidth = .Width * sglFactorX
aGroups(intGroups).sglHeight = .Height * sglFactorY
End If
End With
Next intI
FixGroups = intGroups
End Function

Private Sub FixSections(frm As Form, sglFactorY As Single)

' Loop through all the sections of the form,
' up to 5 sections, setting the height of
' each. If a section isn't there, just keep
' on going.

Dim intI As Integer
Dim varTemp As Variant

' There are 5 possible sections in a form,
' but they might not all be there.
On Error Resume Next
With frm
For intI = 0 To 4
varTemp = .Section(intI).Height * sglFactorY
.Section(intI).Height = IIf(varTemp > glrcMaxTwips,
glrcMaxTwips, varTemp)
Next intI
End With
End Sub

Private Sub GetFormSize(frm As Form, rct As glrTypeRect)

' Fill in rct with the coordinates of the window.

Dim hWndParent As Long
Dim rctParent As glrTypeRect

' Find the position of the window in question, in
' relation to its parent window (the Access desktop,
' the MDIClient window).
hWndParent = glr_apiGetParent(frm.hwnd)

' Get the coordinates of the current window and its parent.
glr_apiGetWindowRect frm.hwnd, rct

' Catch the case where the form is Popup (that is,
' its parent is NOT the Access main window.) In that
' case, don't subtract off the coordinates of the
' Access MDIClient window.
If hWndParent <> Application.hWndAccessApp Then
glr_apiGetWindowRect hWndParent, rctParent

' Subtract off the left and top parent coordinates, since you
' need coordinates relative to the parent for the
glr_apiMoveWindow()
' function call.
With rct
.X1 = .X1 - rctParent.X1
.Y1 = .Y1 - rctParent.Y1
.X2 = .X2 - rctParent.X1
.Y2 = .Y2 - rctParent.Y1
End With
End If
End Sub

Private Sub GetScreenScale(intX As Integer, intY As Integer, sglFactorX As
Single, sglFactorY As Single)
' In: intX, intY: x and y screen resolutions
' when the form was created.
' Out: sglFactorX, sglFactorY: scaling factors for
' the x and y directions.

Dim intScreenX As Integer
Dim intScreenY As Integer

Dim intTwipsPerPixelX As Integer
Dim intTwipsPerPixelY As Integer

Dim lngIC As Long

On Error GoTo GetScreenScaleError

' Get the information context you need to find the screen info.
lngIC = glr_apiCreateIC("DISPLAY", vbNullString, _
vbNullString, vbNullString)

' If the call to CreateIC didn't fail, then get the info.
If lngIC <> 0 Then
' Find the number of pixels in both directions on the
' screen, (640x480, 800x600, 1024x768, 1280x1024?). This
' also takes into account the size of the task bar, whereever
' it is.
intScreenX = glr_apiGetSystemMetrics(glrcSM_CXFULLSCREEN)
intScreenY = glr_apiGetSystemMetrics(glrcSM_CYFULLSCREEN)

' Find the number of twips per pixel in both directions.
intTwipsPerPixelX = glrcTwipsPerInch / glr_apiGetDeviceCaps(lngIC,
glrcLOGPIXELSX)
intTwipsPerPixelY = glrcTwipsPerInch / glr_apiGetDeviceCaps(lngIC,
glrcLOGPIXELSY)

' Release the information context.
glr_apiDeleteDC lngIC

' Get the ratio of the current screen size to the design-time
' screen size.

sglFactorX = intScreenX / intX
sglFactorY = intScreenY / intY

' Finally, take into account the differences in the display
' resolutions. At 640x480, you get more twips per pixel (15)
' as opposed to 12 at higher resolutions.
' Note: GetTwips always takes the X RESOLUTION as its first
parameter.
sglFactorX = sglFactorX * (intTwipsPerPixelX / GetTwips(intX,
glrcXAxis))
sglFactorY = sglFactorY * (intTwipsPerPixelY / GetTwips(intX,
glrcYAxis))
End If

GetScreenScaleExit:
Exit Sub

GetScreenScaleError:
Select Case Err.Number
Case glrcErrDivisionByZero
' It seems that the first time you call
' GetDeviceCaps under Win95 after you've done
' a quick change on the resolution, it returns 0
' for the screen size. This will hopefully correct
' that problem.
Resume
Case Else
HandleError "GetScreenScale", Err.Number, Err.Description
Resume GetScreenScaleExit
End Select
End Sub

tmtony

Private Function GetTwips(intXResolution As Integer, intAxis As Integer)

' Experience has shown that the twips/pixel ratios
' are dependent on the screen resolution. If you find this
' not to be true in your particular case, you'll need to modify
' this routine.

Select Case intXResolution
Case 1024, 1280
GetTwips = IIf(intAxis = glrcXAxis, _
glrcDesignXTwipsHiRes, glrcDesignYTwipsHiRes)
Case 640, 800
GetTwips = IIf(intAxis = glrcXAxis, _
glrcDesignXTwipsLoRes, glrcDesignYTwipsLoRes)
Case Else
' If the value is invalid, just assume the designed used
' a high-res screen. The worst this can do is cause
' an image that's a little small.
GetTwips = IIf(intAxis = glrcXAxis, _
glrcDesignXTwipsHiRes, glrcDesignYTwipsHiRes)
End Select
End Function

Function glrResizeForm(frm As Form, ByVal fDoResize As Variant, rctOriginal
As glrTypeRect)

' Called from the Resize event of forms.
' Attempt to resize the form and all its
' controls. Don't do anything if the
' current height of the form is 0, or if it's iconic.

' From Microsoft Access 95 Developer's Handbook
' by Litwin, Getz, Gilbert, and Reddick (Sybex)
' Copyright 1995. All rights reserved.

' In:
' frm: A reference to the form in question
' fDoResize: Yes/No (Actually do the resize, or just track the
information?)
' rctOriginal: the original coordinates
' Out:
' Nothing

Dim rctNew As glrTypeRect
Dim rctClient As glrTypeRect
Dim varTemp As Variant
Dim intWidth As Integer
Dim intHeight As Integer
Dim sglFactorX As Single
Dim sglFactorY As Single
On Error GoTo glrResizeWindowError
' Make sure the user hasn't sized this thing down
' to the nubs. If the client area is 0 height,
' it's time to call it quits.
glr_apiGetClientRect frm.hwnd, rctNew
intHeight = (rctNew.Y2 - rctNew.Y1)
If intHeight = 0 Or glr_apiIsIconic(frm.hwnd) Then
Exit Function
End If

' Get the current width. Already found the
' current height.
intWidth = (rctNew.X2 - rctNew.X1)

' Calc the scaling factor, given the current
' height/width and the previous height/width.
' Could be that rctOriginal has not yet been
' initialized, so trap for that error.

sglFactorX = intWidth / (rctOriginal.X2 - rctOriginal.X1)
sglFactorY = intHeight / (rctOriginal.Y2 - rctOriginal.Y1)

sglFactorOK:
' Store away the current values for
' the next time through here.
With rctOriginal
.X1 = rctNew.X1
.X2 = rctNew.X2
.Y1 = rctNew.Y1
.Y2 = rctNew.Y2
End With
' If the ratios are 1, there's nothing to do.
If (sglFactorX <> 1) Or (sglFactorY <> 1) Then
' If you actually want to do some resizing, do it now.
If fDoResize Then
SetFormSize frm, sglFactorX, sglFactorY, rctNew, False
End If
End If

glrResizeWindowExit:
Exit Function

glrResizeWindowError:
If Err = glrcErrDivisionByZero Then
sglFactorX = 1
sglFactorY = 1
Resume sglFactorOK
Else
HandleError "glrResizeForm", Err.Number, Err.Description
Resume Next
End If
End Function

Function glrScaleForm(frm As Form, intX As Integer, intY As Integer,
rctOriginal As glrTypeRect)

' Called from the Open event of forms.
' Attempts to scale the form appropriately
' for the given screen size, as compared
' to the size screen on which it was designed.

' From Microsoft Access 95 Developer's Handbook
' by Litwin, Getz, Gilbert, and Reddick (Sybex)
' Copyright 1995. All rights reserved.
'
' In:
' frm: A reference to the form in question
' intX: the horizontal screen resolution at which the form was
designed.
' intY: the vertical screen resolution at which the form was
designed.
' rctOriginal: original coordinates
'
' Out:
' Nothing
' Comments:
' Use a function call like this:
' intRetval = glrScaleForm(Me, 640, 480, rctOriginal)
' to autoscale a form created at 640x480 resolution.

Dim intTwipsPerPixelX As Integer
Dim intTwipsPerPixelY As Integer
Dim intScreenX As Integer
Dim intScreenY As Integer

Dim sglFactorX As Single
Dim sglFactorY As Single

GetScreenScale intX, intY, sglFactorX, sglFactorY

' Whether or not this form gets rescaled,
' you'll need to store away the current size
' for later. The reason you must call GetFormSize
' here, rather than glr_apiGetClientRect, is that
' you need the screen positioning information
' which you don't get with GetClientRect.
GetFormSize frm, rctOriginal

' If the x and y factors are both 1, there's nothing
' to do, so get out here.
If (sglFactorX = 1) And (sglFactorY = 1) Then Exit Function

' If you don't want forms to expand (they were created on a
' lower-resolution device than the current device), but only
' shrink (they were created on a higher-resolution device
' than the current device), then uncomment the next line.
'If (sglFactorX > 1) And (sglFactorY > 1) Then Exit Sub
DoCmd.RepaintObject
SetFormSize frm, sglFactorX, sglFactorY, rctOriginal, True
End Function
Private Sub HandleError(strFunction As String, intErr As Integer, strError
As String)
MsgBox "Error: " & strError & " (" & intErr & ")", vbExclamation,
strFunction
End Sub

tmtony

Private Sub SetFormSize(frm As Form, sglFactorX As Single, sglFactorY As
Single, rct As glrTypeRect, fMove As Integer)

' Actually do the work to resize all the controls
' on the given form, and then resize the form
' itself.

Dim intTemp As Integer
Dim intWidth As Integer
Dim intHeight As Integer
Dim Ctl As Control
Dim sglFontSize As Single
Dim intI As Integer
Dim intGroups As Integer
Dim aGroups() As glrTypeDimensions
Dim colGroups As New Collection
Dim varTemp As Variant

On Error GoTo SetFormSizeError

DoCmd.Hourglass True
frm.Painting = False

' If the form is growing vertically, then need to
' fix up the section heights now. If it's shrinking,
' fix up the heights AFTER you place the controls.
' The same goes for the form width.
If sglFactorY > 1 Then
' Fix up all the section heights.
FixSections frm, sglFactorY
varTemp = frm.Width * sglFactorX
If varTemp > glrcMaxTwips Then
frm.Width = glrcMaxTwips
Else
frm.Width = varTemp
End If
End If

' Now deal with all the controls
' Go through and deal with all the groups and subforms first.
intGroups = FixGroups(frm, aGroups(), sglFactorX, sglFactorY)

' Now go back and deal with all the rest of the controls.
For Each Ctl In frm.Controls

Select Case Ctl.ControlType
Case acOptionGroup
GoTo NextCtl

Case acSubform
' If you've got a subform, then recurse on down into this
' routine again, dealing with all the controls inside of
' that subform.
SetFormSize Ctl.Form, sglFactorX, sglFactorY, rct, False

GoTo NextCtl
Case acPage
'an acPage, is a 'tab page' on a tab control
'The 'tab page' is automatically resized by the tab control
when the tab control itself is resized
'so.. don't resize the tab page. If the tab page WERE TO BE
resized, the tab control will automatically
'resize itself to match the page size (i.e. tab control
resizes increasing the page size, then page is resized
'increasing the tabcontrol size, then the next page is
resized, which again resizes everything etc, etc etc....
'the tab control would grow X times for each page on it)
GoTo NextCtl
End Select

' So the control isn't a subform and it's not a group.
' Therefore, just scale it to the correct size.

' First, fix up the font, if this control has a font
' that needs to be fixed up.
If ChangeFont(Ctl) Then
sglFontSize = Ctl.FontSize * sglFactorY
Else
sglFontSize = -1
End If

' Set the top, left and width values.

If frm.CurrentView <> acDatasheetView Then
Ctl.Top = Ctl.Top * sglFactorY
Ctl.Left = Ctl.Left * sglFactorX
Ctl.Width = Ctl.Width * sglFactorX
End If

' Change the height, if that's required.
If ChangeHeight(Ctl) Then
Ctl.Height = Ctl.Height * sglFactorY
End If

' Only attempt to change the font size for
' certain types of controls.
If sglFontSize >= 1 And sglFontSize <= 127 Then
Ctl.FontSize = sglFontSize
End If
NextCtl:
Next Ctl

' If the form is shrinking vertically, fix up the
' section heights now that all the controls have been
' placed. The same goes for the form width.
If sglFactorY < 1 Then
' Fix up all the section heights.
FixSections frm, sglFactorY
frm.Width = frm.Width * sglFactorX
End If

' Go through and fix up the option groups/subforms,
' which may have been distorted by changes to
' the internal controls.
For intI = 1 To intGroups
With frm(aGroups(intI).strCtlName)
.Top = aGroups(intI).sglTop
.Left = aGroups(intI).sglLeft
.Width = aGroups(intI).sglWidth
.Height = aGroups(intI).sglHeight
End With
Next intI

If fMove Then
intWidth = Int((rct.X2 - rct.X1) * sglFactorX)
intHeight = Int((rct.Y2 - rct.Y1) * sglFactorY)

rct.X1 = Int(rct.X1 * sglFactorX)
rct.Y1 = Int(rct.Y1 * sglFactorY)
rct.X2 = rct.X1 + intWidth
rct.Y2 = rct.Y1 + intHeight

intTemp = glr_apiMoveWindow(frm.hwnd, rct.X1, rct.Y1, intWidth,
intHeight, True)

' Use the Window-Size To Fit menu item.
DoCmd.DoMenuItem acFormBar, acWindow, acSizeToFit, , acMenuVer70

End If

SetFormSizeExit:
frm.Painting = True
DoCmd.Hourglass False
Exit Sub

SetFormSizeError:
Select Case Err
Case glrcErrInvalidProperty
Resume Next
Case Else
'HandleError "SetFormSize", Err.Number, Error.Description
Resume Next
End Select
End Sub

huangli0356

占个位，好好消化一下。。谢谢分享。。

zpy2

缇与象素互换比较有意义，这应是老外想出处理上-一篇用类打开子窗体的方法？

zpy2

方法不错，回头试下，感觉有点外挂的味道，不象VBA了，哈哈

zpy2

http://answers.microsoft.com/en-us/office/forum/access?tab=Threads

zpy2

Ms的，人气不错