Access 2010 VBA Forms - Automatic Form Resize - vba

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.)

A few notes:
Have a look at how to anchor controls to the form so they can resize with the form.
Design your forms so they display properly on the smallest screensize that your users have.
It's important that you think about how your users will interact with your application. You cannot expect Access to magically reflow and resize everything, it's something you, as the designer of the application, need to think about.
So limit the number of controls on your form, and keep them small enough that they display correctly on whatever is the smallest reasonable screen resolution in your office.
If you do not want bars to appear, look at the form's scrollbars properties.
Look into the various form styles you can use: in Access 2007 and above, you can use forms in tabs. You can also make them popup, and prevent them from being resized.
Look into the following form properties and play around the various combinations to get the desired effect:

Related

Dynamically Duplicating a page in a Multipage

Good afternoon, So I have been assigned a task where I'm supposed to take a Calendar Userform I made and implement the ability to duplicate as many calendars as needed as tabs on a multipage Userform.
My question is : Is it possible to do so dynamically? I copied over all the controls over to another tab to test it, but all the control buttons get renamed and I'm not able to name them the the same name as the buttons on the 'master page' because of the ambiguity error when naming 2 buttons the same on one userform.
I could write new code using the new button names, but this would not be able to be done dynamically since for ever new tab added, I'd have to have code ready for it prior to creation.
Any help would greatly be appreciated.
Demo Workbook
The key to handling this type of problem is to create a class to hold references to the newly created controls. Using WithEvents will allow you to handle the events of the referenced controls.
Read about WithEvents here: Events And Event Procedures In VBA
In order to make this work you'll have to Set references between the newly created Page controls and their doppelgangers in your class. You'll also need to keep the class references alive by adding them to a global collection, dictionary or array.
In my example I created a subroutine that will iterate over the template page controls, creating and copy the code necessary to declare the variable and set the references into the Windows ClipBoard.
The final step is to copy the event code from the Userform into the class module.
Download Demo Workbook for the code example.
Alternatively, you could replace the Multipage control with a TabStrip control. The difference is that you can have the controls on a TabStrip span across all the Tabs. You could than use the TabStrip1_Change() to update the controls based on the selected tab (TabStrip1.SelectedItem).
First of all I would recommend looking at Thomas Inzina's answer.
However, in one of my worksheets I did the same without relying on WithEvents, so I wanted to show the alternative method.
This method sets names of the controls along a predetermined format (e.g. "Input1_" (counter + 1)) so the controls are easily referenced from other operations.
The controls themselves are within Frames with set Captions, so I can still reference them after they've been copied.
I've edited the code somewhat since I stripped it from a longer procedure, but hopefully it's still intact.
Dim Ctrl As msforms.Control
Dim Mpage As msforms.Control
Dim Ctrl2 As msforms.Control
Dim pge As msforms.Page
Dim L As Double, R As Double
Dim PageName As String, PageTitle As String
Dim counter As Long
counter = 0
Set Mpage = Me.Controls("Multipage_1") 'set Multipage
'count current number of tabs within MPage
For Each pge In Mpage.Pages
counter = counter + 1
Next pge
'set name/title for new page
PageName = "Tab_" & (counter + 1)
PageTitle = "Tab " & (counter + 1)
With Mpage 'add tab
.Pages.Add PageName, PageTitle
.Pages(0).Controls.Copy
.Pages(counter).Paste
End With
'get position of original frame (controls are within this frame)
For Each Ctrl In Mpage.Pages(0).Controls
If TypeOf Ctrl Is msforms.Frame Then
L = Ctrl.Left
R = Ctrl.Top
Exit For
End If
Next
'apply position to new frame
For Each Ctrl In Mpage.Pages(counter).Controls
If TypeOf Ctrl Is msforms.Frame Then
Ctrl.Left = L
Ctrl.Top = R
Exit For
End If
Next
'renames input-controls and removes copied values by looping through frames
'that contain the controls, since frame-captions can be duplicates
For Each Ctrl In Mpage.Pages(counter).Controls
If TypeOf Ctrl Is msforms.Frame Then
Select Case Ctrl.Caption
Case "Input1"
For Each Ctrl2 In Ctrl.Controls
Ctrl2.Name = "Input1_" (counter + 1)
Ctrl2.Text = ""
Next Ctrl2
Case "Input2"
For Each Ctrl2 In Ctrl.Controls
Ctrl2.Name = "Input2_" (counter + 1)
Ctrl2.Text = ""
Next Ctrl2
Case "Input3"
For Each Ctrl2 In Ctrl.Controls
Ctrl2.Name = "Input3_" (counter + 1)
Ctrl2.Text = ""
Next Ctrl2
End Select
End If
Next Ctrl
use a prefix for the control names. eg. tab1_button1, tab2_button1, tab33_button1. then have only one one event handler that services all the events (button presses, checkbox clicks)
here is some info using one sub for multiple buttons in excel vba

VBA ActiveX dynamic ComboBox reduces ListRows to 1

I am trying to get a VBA ComboBox to dropdown and display only those items which match or partially match the typed string.
For this purpose, I have set up a ComboBox KeyUp event manager, as follows:
Public Sub TempCombo_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
'If TAB is pressed, then move one place right
ActiveCell.Offset(0, 1).Activate
Case 13
'If Enter is pressed, then move one place down
ActiveCell.Offset(1, 0).Activate
Case Else
'Otherwise, filter the list from the already entered text
Dim x As Long
OriginalValue = Me.TempCombo.Value
'Remove items from the ComboBox list
If Me.TempCombo.ListCount > 0 Then
For i = 1 To Me.TempCombo.ListCount
Me.TempCombo.RemoveItem 0
Next
End If
'If any part of any element from the 'FullSource' array matches the so far typed ComboBox value, then include it in the list for dropdown
For x = 1 To UBound(FullSource)
Typed_Value = "*" & LCase(OriginalValue) & "*"
If LCase(FullSource(x)) Like Typed_Value Then
Me.TempCombo.Object.AddItem FullSource(x)
End If
Next
Me.TempCombo.Value = OriginalValue
Me.TempCombo.ListRows = 12
Me.TempCombo.DropDown
End Select
End Sub
The code seems to do the filtering fine. But the dropdown list height is only one unit tall. I have to scroll through this small box, using the mouse buttons.
Why the dropdown list reduces in size is a mystery to me, and I'd appreciate if any light can be thrown on this. Perhaps there is some setting that I am overlooking.
Thanks
You can use Me.TempCombo.Height = 15 to set the height.
If it doesn't work, you are probably running into ActiveX control instability issues. Refer to Excel VBA ComboBox DropDown Button Size--changed itself to use form controls instead of ActiveX.
Dynamically adjusting the width of a combobox in Excel VBA for more details on setting this dynamically.

Updating Word Form Field

I have a Word form that I am working on.
It has one field that is supposed to be calculated from other fields.
In the prior iteration, you could click the cell in the table and hit F9 and the field would update.
I have since added some other buttons and VBA and now you can no longer click the cell when "Restrict Editing" is on.
I have tried a button tied to VBA that will update all fields, but when you click that button, you cannot edit any of the fields.
How can I update this field, and still be able to manually update my other fields?
The problem was that Content Controls and ActiveX buttons are not altogether compatible. Also, the programmer I had inherited the form from was using a simple field calculation based on the table in the document instead of VBA. I was able to come up with a better solution. I used the sub:
Private Sub Document_ContentControlOnExit(ByVal thisControl As ContentControl, Cancel As Boolean)
End Sub
to execute code onExit from the controls. This function executes on ALL Content Controls as the user exits the Content Control. Another tool I developed was the following function which will find the index of the control with the given title:
'Function to get control index given the control title
'PARAMETER Control Title as String
'RETURN Control Index as Integer
Public Function GetControlIndex(ccTitle As String) As Integer
'Function Variable Declaration
Dim objCC As ContentControl
'look at each ContentControl
For i = 1 To ActiveDocument.ContentControls.count
Set objCC = ActiveDocument.ContentControls.Item(i)
With objCC
If .Title = ccTitle Then
GetControlIndex = i
End If
End With
Next i
End Function

Select ListBox item on rightclick in Word VBA

I'm developping a project in Word 2003 with VBA. I have a multiselect ListBox with some entries (dates). On rightclick I'd like to have an InputBox popping up where the user can change the selected date. This works well, as long a specific item is already focused (not only selected, but focused). But, if you rightclick on an item without focus, the box shows up and changes the date of the focused entry, not always the one you rightclicked.
I found this answer (http://www.vbarchiv.net/tipps/tipp_920-rechtsklick-in-der-standard-listbox-erkennen.html) but it's not possible in VBA. Has anyone a solution for VBA?
I actually need to change the focused item on rightclick, before the box shows up.
Thank you
This is usually done with Hit Testing which Listboxes don't support, here is a hacky way;
Add another listbox called lbTest somewhere on the form, double click its BorderStyle property until it looks like an empty white box, set its visible to false
Private LBI_HEIGHT As Long
Private Sub UserForm_Initialize()
'get the height of a single list item in twips based on the fact the box will resize itself automatically;
With lbTest
.Width = 100
.Height = 1
.AddItem "X"
LBI_HEIGHT = .Height
End With
'add test data
Dim i As Long
For i = 1 To 50
ListBox1.AddItem "item " & i
Next
End Sub
Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'get the item at the Y coord based on the scroll position & item height
Dim derivedIndex As Long
derivedIndex = (Y \ LBI_HEIGHT) + ListBox1.TopIndex
Me.Caption = derivedIndex & " = " & ListBox1.List(derivedIndex)
End Sub

How to position the userform below the command button

I have created a command button and when I click the button an userform1 is shown and the userform has a calender control in it and it is popping at the center of screen but I want that to be positioned below the command button. Is there a way to say that position the userform1 below the button?
Well, I have given the axes size and its working on my pc but when the pixels changes it is somewhere again.
I assume the Command button in on one user form and the calendar control on another.
You do not say which version of VBA you are using. I tested this in Excel 2003. I know better solutions are available in, for example, VB 2010.
Approach 1
Do you need a second form? You can hide a control with:
ControlName.Visible = False
and make it visible with
ControlName.Visible = True
Approach 2
You need some public variables in a module:
Public ButLeft As Integer
Public ButHeight As Integer
Public ButTop As Integer
Public Form1Left As Integer
Public Form1Top As Integer
Within the click event for the command button, include:
' This stores information about the current position of
' Form 1 relative to the active window.
With Me
Form1Top = .Top
Form1Left = .Left
End With
' This stores information about the current position of the
' command button relative to the useable part of Form 1.
With Me.CommandButton
ButTop = .Top
ButLeft = .Left
ButLeft = .Height
End With
Within Form 2 include:
Private Sub UserForm_Activate()
' This positions Form 2 relative to the current position
' of the command button. The "+50" is because the stored
' values do not allow for the width of Form1's border.
' Experiment to get values that look good to you.
With Me
.Top = FormTop + But1Top + But1Height + 50
.Left = FormLeft + But1Left + 50
End With
End Sub
With this code, Form 2 displays under the command button no matter how the user moves Form 1.