Access 2010 VBA表单-自动调整表单大小 [英] Access 2010 VBA Forms - Automatic Form Resize
问题描述
我已经完成了要在办公室附近使用的表单，但是，当在不同的计算机上打开表单时，表单的大小不会调整.相反，会出现滚动条.如何使表单和控件自动调整大小?
以下是您可以添加到表单中的一些VBA代码，无论用户在其窗口上放置了多大或多小，该表单都将保持相同的外观监视器或其监视器分辨率是多少.
还可以通过按住 Ctrl 键并上下滚动鼠标滚轮(或按住 Shift 键并点击 + 键或-键.)
要使用此功能，只需打开Access并在设计视图中打开您的表单.首先，右键单击表单图像，然后添加Form Header/Footer.
如果不将页眉和页脚添加到窗体，则下面的代码将出错.但是，如果您不希望页眉和页脚的高度出现在窗体上，则可以将它们的高度缩小为空.
通过点击表单左上方位于标签下方的小框来选择表单本身:
这将确保我们在查看Property Sheet时正在查看表单本身的属性.
要查看表单的Property Sheet(如果尚不可见)，请按住 Alt 键，然后按 Enter 键.
选择Event标签.
然后，您需要将文字文本[Event Procedure]添加到表单本身后面的以下五个事件中:
加载时
按键向上
按键按下
调整大小时
在鼠标滚轮上
您可以在这些事件旁边的文本框中键入文字文本[Event Procedure]，或者单击每个事件旁边的省略号(...)，然后从弹出菜单中选择Code Builder.
它看起来像这样:
...
...
...
...
此外，在事件列表的底部，您还需要将Key Preview属性更改为Yes:
最后，您可能需要关闭表单上的Scroll Bars，以使它们不与任何内容重叠.为此，请在设计视图中转到表单的Property Sheet的Format选项卡，然后将Scroll Bars属性更改为Neither.
现在，要添加VBA代码，请按住 Alt 并按 F11 以查看VBA编辑器.
在VBA编辑器中，双击Microsoft Access Class Objects文件夹下的Form_YourFormName选项:
如果没有看到Microsoft Access Class Objects文件夹，则返回到设计视图中的表单，并在您刚刚修改的任何事件上，单击文字文本[Event Procedure]旁边的省略号(...). /p>
这将带您回到VBA编辑器，您现在应该位于Form_YourFormName代码区域内.那里已经有一些代码，但是您可以删除所有代码，然后继续下一步.
然后在右侧屏幕的主要部分中，只需将以下代码复制并粘贴即可.
Option Compare Database
Option Explicit
'Set an unchangeable variable to the amount (10% for example) to increase or
'decrease the font size with each zoom, in or out.
Const FONT_ZOOM_PERCENT_CHANGE = 0.1
'Create the fontZoom and ctrlKeyIsPressed variables outside of
'the sub definitions so they can be shared between subs
Private fontZoom As Double
Private ctrlKeyIsPressed As Boolean
'Create an enum so we can use it later when pulling the data out of the "Tag" property
Private Enum ControlTag
FromLeft = 0
FromTop
ControlWidth
ControlHeight
OriginalFontSize
OriginalControlHeight
End Enum
Private Sub Form_Load()
'Set the font zoom setting to the default of 100% (represented by a 1 below).
'This means that the fonts will appear initially at the proportional size
'set during design time. But they can be made smaller or larger at run time
'by holding the "Shift" key and hitting the "+" or "-" key at the same time,
'or by holding the "Ctrl" key and scrolling the mouse wheel up or down.
fontZoom = 1
'When the form loads, we need to find the relative position of each control
'and save it in the control's "Tag" property so the resize event can use it
SaveControlPositionsToTags Me
End Sub
Private Sub Form_Resize()
'Set the height of the header and footer before calling RepositionControls
'since it caused problems changing their heights from inside that sub.
'The Tag property for the header and footer is set inside the SaveControlPositionsToTags sub
Me.Section(acHeader).Height = Me.WindowHeight * CDbl(Me.Section(acHeader).Tag)
Me.Section(acFooter).Height = Me.WindowHeight * CDbl(Me.Section(acFooter).Tag)
'Call the RepositionControls Sub and pass this form as a parameter
'and the fontZoom setting which was initially set when the form loaded and then
'changed if the user holds the "Shift" key and hits the "+" or "-" key
'or holds the "Ctrl" key and scrolls the mouse wheel up or down.
RepositionControls Me, fontZoom
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'PURPOSE: Make the text on the form bigger if "Shift" and "+" are pressed
'at the same time and smaller if "Shift" and "-" are pressed at the same time.
'NOTE: Using the "Ctrl" key instead of the "Shift" key conflicts with Access's
'default behavior of using "Ctrl -" to delete a record, so "Shift" is used instead
'Was the "Shift" key being held down while the Key was pressed?
Dim shiftKeyPressed As Boolean
shiftKeyPressed = (Shift And acShiftMask) > 0
'If so, check to see if the user pressed the "+" or the "-" button at the
'same time as the "Shift" key. If so, then make the font bigger/smaller
'by the percentage specificed in the FONT_ZOOM_PERCENT_CHANGE variable.
If shiftKeyPressed Then
Select Case KeyCode
Case vbKeyAdd
fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
'Set the KeyCode back to zero to prevent the "+" symbol from
'showing up if a textbox or similar control has the focus
KeyCode = 0
Case vbKeySubtract
fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
'Set the KeyCode back to zero to prevent the "-" symbol from
'showing up if a textbox or similar control has the focus
KeyCode = 0
End Select
End If
'Detect if the "Ctrl" key was pressed. This variable
'will be used later when we detect a mouse wheel scroll event.
If (Shift And acCtrlMask) > 0 Then
ctrlKeyIsPressed = True
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
'Change the ctrlKeyIsPressed variable to false when
'any key is let up. This will make sure the form text does
'not continue to grow/shrink when the mouse wheel is
'scrolled after the ctrl key is pressed and let up.
ctrlKeyIsPressed = False
End Sub
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
'If the "Ctrl" key is also being pressed, then zoom the form in or out
If ctrlKeyIsPressed Then
Debug.Print ctrlKeyIsPressed
'The user scrolled up, so make the text larger
If Count < 0 Then
'Make the font bigger by the percentage specificed
'in the FONT_ZOOM_PERCENT_CHANGE variable
fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
'The user scrolled down, so make the text smaller
ElseIf Count > 0 Then
'Make the font smaller by the percentage specificed
'in the FONT_ZOOM_PERCENT_CHANGE variable
fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
End If
End If
End Sub
Public Sub SaveControlPositionsToTags(frm As Form)
On Error Resume Next
Dim ctl As Control
Dim ctlLeft As String
Dim ctlTop As String
Dim ctlWidth As String
Dim ctlHeight As String
Dim ctlOriginalFontSize As String
Dim ctlOriginalControlHeight As String
For Each ctl In frm.Controls
'Find the relative position of this control in design view
'e.g.- This control is 5% from the left, 10% from the top, etc.
'Those percentages can then be saved in the Tag property for this control
'and used later in the form's resize event
ctlLeft = CStr(Round(ctl.Left / frm.Width, 4))
ctlTop = CStr(Round(ctl.Top / frm.Section(ctl.Section).Height, 4))
ctlWidth = CStr(Round(ctl.Width / frm.Width, 4))
ctlHeight = CStr(Round(ctl.Height / frm.Section(ctl.Section).Height, 4))
'If this control has a FontSize property, then capture the
'control's original font size and the control's original height from design-time
'These will be used later to calculate what the font size should be when the form is resized
Select Case ctl.ControlType
Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
ctlOriginalFontSize = ctl.FontSize
ctlOriginalControlHeight = ctl.Height
End Select
'Add all this data to the Tag property of the current control, separated by colons
ctl.Tag = ctlLeft & ":" & ctlTop & ":" & ctlWidth & ":" & ctlHeight & ":" & ctlOriginalFontSize & ":" & ctlOriginalControlHeight
Next
'Set the Tag properties for the header and the footer to their proportional height
'in relation to the height of the whole form (header + detail + footer)
frm.Section(acHeader).Tag = CStr(Round(frm.Section(acHeader).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 4))
frm.Section(acFooter).Tag = CStr(Round(frm.Section(acFooter).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 4))
End Sub
Public Sub RepositionControls(frm As Form, fontZoom As Double)
On Error Resume Next
Dim formDetailHeight As Long
Dim tagArray() As String
'Since "Form.Section(acDetail).Height" usually returns the same value (unless the detail section is tiny)
'go ahead and calculate the detail section height ourselves and store it in a variable
formDetailHeight = frm.WindowHeight - frm.Section(acHeader).Height - frm.Section(acFooter).Height
Dim ctl As Control
'Loop through all the controls on the form
For Each ctl In frm.Controls
'An extra check to make sure the Tag property has a value
If ctl.Tag <> "" Then
'Split the Tag property into an array
tagArray = Split(ctl.Tag, ":")
If ctl.Section = acDetail Then
'This is the Detail section of the form so use our "formDetailHeight" variable from above
ctl.Move frm.WindowWidth * (CDbl(tagArray(ControlTag.FromLeft))), _
formDetailHeight * (CDbl(tagArray(ControlTag.FromTop))), _
frm.WindowWidth * (CDbl(tagArray(ControlTag.ControlWidth))), _
formDetailHeight * (CDbl(tagArray(ControlTag.ControlHeight)))
Else
ctl.Move frm.WindowWidth * (CDbl(tagArray(ControlTag.FromLeft))), _
frm.Section(ctl.Section).Height * (CDbl(tagArray(ControlTag.FromTop))), _
frm.WindowWidth * (CDbl(tagArray(ControlTag.ControlWidth))), _
frm.Section(ctl.Section).Height * (CDbl(tagArray(ControlTag.ControlHeight)))
End If
'Now we need to change the font sizes on the controls.
'If this control has a FontSize property, then find the ratio of
'the current height of the control to the form-load height of the control.
'So if form-load height was 1000 (twips) and the current height is 500 (twips)
'then we multiply the original font size * (500/1000), or 50%.
'Then we multiply that by the fontZoom setting in case the user wants to
'increase or decrease the font sizes while viewing the form.
Select Case ctl.ControlType
Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
ctl.FontSize = Round(CDbl(tagArray(ControlTag.OriginalFontSize)) * CDbl(ctl.Height / tagArray(ControlTag.OriginalControlHeight))) * fontZoom
End Select
End If
Next
End Sub
以下是缩小表单时的屏幕截图.
之前:
之后:
此外，您可以通过按住 Ctrl 键并向上滚动鼠标滚轮(或通过按住 Shift 键并按 + 键.)
而且，您可以通过按住 Ctrl 键并向下滚动鼠标滚轮来缩小文本(或按住 Shift 键并按-键.)
I have complete my form to use around the office, however, when opened on different computers the form doesnt resize.Instead, the scroll bar appears. How can i make the form and controls automatically resize ?
Here is some VBA code you could add to your form that will keep the form looking the same no matter how large or small the user has made the window on their monitor or what their monitor resolution is.
Also you can make the text larger or smaller by holding the Ctrl key and scrolling the mouse wheel up and down (or, alternatively, holding the Shift key and hitting the + key or the - key.)
To use this functionality, just open Access and open your form in design view. First, right-click on the image of the form and add the Form Header/Footer.
If you don't add the header and footer to the form, the code below will error out. However, you can shrink the height of both the header and the footer to nothing if you don't want them to appear on your form.
Select the Form itself by clicking the little box at the top left of the form, just below the tab:
This will make sure we are looking at the properties for the form itself when we view the Property Sheet.
To view the Property Sheet for the form (if it isn't visible already), hold the Alt key and press the Enter key.
Choose the Event tab.
You'll then need to add the literal text [Event Procedure] to the following five events behind the form itself:
On Load
On Key Up
On Key Down
On Resize
On Mouse Wheel
You can either type the literal text [Event Procedure] into the text box next to these events, or click the ellipsis (...) button next to each event and choose Code Builder from the pop up menu.
It will look something like this:
...
...
...
...
Also, at the bottom of the list of events, you'll also need to change the Key Preview property to Yes:
Finally, you'll probably want to turn Scroll Bars off on the form so that they don't overlap any content. To do this, go to the Format tab of the Property Sheet for your form in design view and change the Scroll Bars property to Neither.
Now, to add the VBA code, hold Alt and hit F11 to view the VBA editor.
Once inside the VBA editor, double click on the Form_YourFormName option under the Microsoft Access Class Objects folder:
If you do not see the Microsoft Access Class Objects folder, then go back to the form in design view and click the ellipsis (...) next to the literal text [Event Procedure] on any of the events you just modified.
This will take you back to the VBA editor and you should now be inside the Form_YourFormName code area. There will already be some code there, but you can erase all of it before proceeding to the next step.
Then in the main part of the screen on the right, just copy and paste the code below and you're done.
Option Compare Database
Option Explicit
'Set an unchangeable variable to the amount (10% for example) to increase or
'decrease the font size with each zoom, in or out.
Const FONT_ZOOM_PERCENT_CHANGE = 0.1
'Create the fontZoom and ctrlKeyIsPressed variables outside of
'the sub definitions so they can be shared between subs
Private fontZoom As Double
Private ctrlKeyIsPressed As Boolean
'Create an enum so we can use it later when pulling the data out of the "Tag" property
Private Enum ControlTag
FromLeft = 0
FromTop
ControlWidth
ControlHeight
OriginalFontSize
OriginalControlHeight
End Enum
Private Sub Form_Load()
'Set the font zoom setting to the default of 100% (represented by a 1 below).
'This means that the fonts will appear initially at the proportional size
'set during design time. But they can be made smaller or larger at run time
'by holding the "Shift" key and hitting the "+" or "-" key at the same time,
'or by holding the "Ctrl" key and scrolling the mouse wheel up or down.
fontZoom = 1
'When the form loads, we need to find the relative position of each control
'and save it in the control's "Tag" property so the resize event can use it
SaveControlPositionsToTags Me
End Sub
Private Sub Form_Resize()
'Set the height of the header and footer before calling RepositionControls
'since it caused problems changing their heights from inside that sub.
'The Tag property for the header and footer is set inside the SaveControlPositionsToTags sub
Me.Section(acHeader).Height = Me.WindowHeight * CDbl(Me.Section(acHeader).Tag)
Me.Section(acFooter).Height = Me.WindowHeight * CDbl(Me.Section(acFooter).Tag)
'Call the RepositionControls Sub and pass this form as a parameter
'and the fontZoom setting which was initially set when the form loaded and then
'changed if the user holds the "Shift" key and hits the "+" or "-" key
'or holds the "Ctrl" key and scrolls the mouse wheel up or down.
RepositionControls Me, fontZoom
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'PURPOSE: Make the text on the form bigger if "Shift" and "+" are pressed
'at the same time and smaller if "Shift" and "-" are pressed at the same time.
'NOTE: Using the "Ctrl" key instead of the "Shift" key conflicts with Access's
'default behavior of using "Ctrl -" to delete a record, so "Shift" is used instead
'Was the "Shift" key being held down while the Key was pressed?
Dim shiftKeyPressed As Boolean
shiftKeyPressed = (Shift And acShiftMask) > 0
'If so, check to see if the user pressed the "+" or the "-" button at the
'same time as the "Shift" key. If so, then make the font bigger/smaller
'by the percentage specificed in the FONT_ZOOM_PERCENT_CHANGE variable.
If shiftKeyPressed Then
Select Case KeyCode
Case vbKeyAdd
fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
'Set the KeyCode back to zero to prevent the "+" symbol from
'showing up if a textbox or similar control has the focus
KeyCode = 0
Case vbKeySubtract
fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
'Set the KeyCode back to zero to prevent the "-" symbol from
'showing up if a textbox or similar control has the focus
KeyCode = 0
End Select
End If
'Detect if the "Ctrl" key was pressed. This variable
'will be used later when we detect a mouse wheel scroll event.
If (Shift And acCtrlMask) > 0 Then
ctrlKeyIsPressed = True
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
'Change the ctrlKeyIsPressed variable to false when
'any key is let up. This will make sure the form text does
'not continue to grow/shrink when the mouse wheel is
'scrolled after the ctrl key is pressed and let up.
ctrlKeyIsPressed = False
End Sub
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
'If the "Ctrl" key is also being pressed, then zoom the form in or out
If ctrlKeyIsPressed Then
Debug.Print ctrlKeyIsPressed
'The user scrolled up, so make the text larger
If Count < 0 Then
'Make the font bigger by the percentage specificed
'in the FONT_ZOOM_PERCENT_CHANGE variable
fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
'The user scrolled down, so make the text smaller
ElseIf Count > 0 Then
'Make the font smaller by the percentage specificed
'in the FONT_ZOOM_PERCENT_CHANGE variable
fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE
RepositionControls Me, fontZoom
End If
End If
End Sub
Public Sub SaveControlPositionsToTags(frm As Form)
On Error Resume Next
Dim ctl As Control
Dim ctlLeft As String
Dim ctlTop As String
Dim ctlWidth As String
Dim ctlHeight As String
Dim ctlOriginalFontSize As String
Dim ctlOriginalControlHeight As String
For Each ctl In frm.Controls
'Find the relative position of this control in design view
'e.g.- This control is 5% from the left, 10% from the top, etc.
'Those percentages can then be saved in the Tag property for this control
'and used later in the form's resize event
ctlLeft = CStr(Round(ctl.Left / frm.Width, 4))
ctlTop = CStr(Round(ctl.Top / frm.Section(ctl.Section).Height, 4))
ctlWidth = CStr(Round(ctl.Width / frm.Width, 4))
ctlHeight = CStr(Round(ctl.Height / frm.Section(ctl.Section).Height, 4))
'If this control has a FontSize property, then capture the
'control's original font size and the control's original height from design-time
'These will be used later to calculate what the font size should be when the form is resized
Select Case ctl.ControlType
Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
ctlOriginalFontSize = ctl.FontSize
ctlOriginalControlHeight = ctl.Height
End Select
'Add all this data to the Tag property of the current control, separated by colons
ctl.Tag = ctlLeft & ":" & ctlTop & ":" & ctlWidth & ":" & ctlHeight & ":" & ctlOriginalFontSize & ":" & ctlOriginalControlHeight
Next
'Set the Tag properties for the header and the footer to their proportional height
'in relation to the height of the whole form (header + detail + footer)
frm.Section(acHeader).Tag = CStr(Round(frm.Section(acHeader).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 4))
frm.Section(acFooter).Tag = CStr(Round(frm.Section(acFooter).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 4))
End Sub
Public Sub RepositionControls(frm As Form, fontZoom As Double)
On Error Resume Next
Dim formDetailHeight As Long
Dim tagArray() As String
'Since "Form.Section(acDetail).Height" usually returns the same value (unless the detail section is tiny)
'go ahead and calculate the detail section height ourselves and store it in a variable
formDetailHeight = frm.WindowHeight - frm.Section(acHeader).Height - frm.Section(acFooter).Height
Dim ctl As Control
'Loop through all the controls on the form
For Each ctl In frm.Controls
'An extra check to make sure the Tag property has a value
If ctl.Tag <> "" Then
'Split the Tag property into an array
tagArray = Split(ctl.Tag, ":")
If ctl.Section = acDetail Then
'This is the Detail section of the form so use our "formDetailHeight" variable from above
ctl.Move frm.WindowWidth * (CDbl(tagArray(ControlTag.FromLeft))), _
formDetailHeight * (CDbl(tagArray(ControlTag.FromTop))), _
frm.WindowWidth * (CDbl(tagArray(ControlTag.ControlWidth))), _
formDetailHeight * (CDbl(tagArray(ControlTag.ControlHeight)))
Else
ctl.Move frm.WindowWidth * (CDbl(tagArray(ControlTag.FromLeft))), _
frm.Section(ctl.Section).Height * (CDbl(tagArray(ControlTag.FromTop))), _
frm.WindowWidth * (CDbl(tagArray(ControlTag.ControlWidth))), _
frm.Section(ctl.Section).Height * (CDbl(tagArray(ControlTag.ControlHeight)))
End If
'Now we need to change the font sizes on the controls.
'If this control has a FontSize property, then find the ratio of
'the current height of the control to the form-load height of the control.
'So if form-load height was 1000 (twips) and the current height is 500 (twips)
'then we multiply the original font size * (500/1000), or 50%.
'Then we multiply that by the fontZoom setting in case the user wants to
'increase or decrease the font sizes while viewing the form.
Select Case ctl.ControlType
Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
ctl.FontSize = Round(CDbl(tagArray(ControlTag.OriginalFontSize)) * CDbl(ctl.Height / tagArray(ControlTag.OriginalControlHeight))) * fontZoom
End Select
End If
Next
End Sub
Here are some screenshots of what a form looks like when shrunk.
Before:
After:
Also, you can make the text larger by holding the Ctrl key and scrolling the mouse wheel up (or, alternatively by holding the Shift key and pressing the + key.)
And, you can make the text smaller by holding the Ctrl key and scrolling the mouse wheel down (or, alternatively by holding the Shift key and pressing the - key.)
这篇关于Access 2010 VBA表单-自动调整表单大小的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
