Select ListBox item on rightclick in Word VBA - 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

Related

VBa - Userform show same combobox on two pages

So I have a multipage where I want the same button to show on both pages. I could place it outside but the border from the multipage is so ugly so I tried to place everything on the pages. Unfortunately you can't name the items (such as the combobox) with the same name. Is there a workaround to remove the borders and just show the page names or have the same name on the item on two pages?
Had some fun with this goal.
Consider this UserForm in Editor with TabStrip, 2 frames and some other controls.
Frames are named from Frame0, Frame1, etc.
Assuming the Frame0 is the location reference and first to display when UserForm is displayed, code below will be what you want.
Code:
Option Explicit
Private Sub TabStrip1_Change()
Dim i As Long, lActiveTabIndex As Long
lActiveTabIndex = Me.TabStrip1.Value
For i = 0 To Me.TabStrip1.Tabs.Count - 1
Me.Controls("Frame" & i).Visible = (i = lActiveTabIndex)
Next i
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
With Me
.Height = 288 ' Adjust to your desired height
' Align all FrameX top/left to same as Frame0, delete Caption and SpecialEffect
For i = 0 To Me.TabStrip1.Tabs.Count - 1
With Me.Controls("Frame" & i)
.Top = Me.Frame0.Top
.Left = Me.Frame0.Left
.Caption = ""
.SpecialEffect = fmSpecialEffectFlat
End With
Next i
End With
' Ensure frame for first tab is displayed
TabStrip1_Change
End Sub
Userform first load (didn't save screenshot, neither the workbook, sorry).
Next tab clicked:

VBA - Error While Programming a Class to Operate all Checkboxes on Userform

Here is a bit of background on what I'm trying to do: I'm creating a userform to track Inventory items and prices, using checkboxes in a multipage object. The clerk checks off everything put into an order and uses a submit button, which will take some actions.
In order for the project not to require a coding person every time Inventory items change, the checkboxes are being dynamically generated when the userform is activated, from cell values on an Inventory sheet. The clerks just adjust the Inventory sheet and the form automatically adjusts for them.
This is my code to dynamically create all the checkboxes (currently this form can accommodate up to 160 possible checkboxes), in case this is effecting my issue (side note, each tab on the multipage has a frame on it, and all checkboxes are within the frame, so I could change background colors, the frame in this example being titled "frmreg"):
Sub StoreFrmRegCheckboxGenerator()
'Works with the store userform
Dim curColumn As Long
Dim LastRow As Long
Dim i As Long
Dim chkBox As msforms.CheckBox
'This sub dynamically creates checkboxes on the Regular Items tab based
'on values in Column A of the Inventory sheet
curColumn = 1 'Set your column index here
LastRow = Worksheets("Inventory").Cells(Rows.Count, curColumn).End(xlUp).Row
For i = 2 To 9
If Worksheets("Inventory").Cells(i, curColumn).Value <> "" Then
Set chkBox = store.frmreg.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i)
chkBox.Caption = Worksheets("Inventory").Cells(i, curColumn).Value & " - $" & Worksheets("Inventory").Cells(i, curColumn).Offset(0, 1).Value
chkBox.AutoSize = True
chkBox.WordWrap = True
chkBox.Left = 5
chkBox.Top = 1 + ((i - 1) * 25)
End If
Next i
'Cut some code out here identical to this previous section, but for the rest of the cells in column A up to Row 33, in blocks of 8
End Sub
The above code is in the Userform_Initialize sub, and it works perfectly.
However, since the number of checkboxes is not static, and can be as many as 160, I'm trying to write one sub to take the same set of actions any time any checkbox is clicked.
The closest solution I've found is from this question: Excel Macro Userform - single code handling multiple checkboxes, from sous2817.
Here is his code that I'm trying to use:
In a new class module:
Option Explicit
Public WithEvents aCheckBox As msforms.CheckBox
Private Sub aCheckBox_Click()
MsgBox aCheckBox.Name & " was clicked" & vbCrLf & vbCrLf & _
"Its Checked State is currently " & aCheckBox.Value, vbInformation + vbOKOnly, _
"Check Box # & State"
End Sub
The "store" userform, at the top, right under Option Explicit:
Dim myCheckBoxes() As clsUFCheckBox
At the bottom of the Userform_Initialize sub, AFTER I call the all the subs that dynamically create all the checkboxes:
Dim ctl As Object, pointer As Long
ReDim myCheckBoxes(1 To Me.Controls.Count)
For Each ctl In Me.Controls
If TypeName(ctl) = "CheckBox" Then
pointer = pointer + 1
Set myCheckBoxes(pointer) = New clsUFCheckBox
Set myCheckBoxes(pointer).aCheckBox = ctl
End If
Next ctl
ReDim Preserve myCheckBoxes(1 To pointer)
When I try to open the userform I get this error:
"Compile Error: User-defined type not defined"
Pointing to this line:
Dim myCheckBoxes() As clsUFCheckBox
Am I missing a library reference? I haven't been able to figure this out.

How to tell which dynamic control sent to an event?

This is my first attempt at working with dynamically created controls in a user form. The reason is there will always be a different amount of rows returned by some processing.
I have created a class object cControlEvent with the following code. (I cut out the code not pertaining to the checkbox)
Public WithEvents CHK As MSForms.CheckBox
Private Sub CHK_Change()
** tell me which box was changed **
End Sub
in the code module, I have the following code:
Dim CHK_Evts As New Collection
sub Form_Builder()
**non relevant code deleted****
Set Evt = New cControlEvent
If i_Columns = 1 Then
Set Evt.CHK = ctl
CHK_Evts.Add Evt
Else
** more code**
End if
end sub
What do I need to change/add to be able to get the name of the control that is firing off the change event?
EDITED TO ADD:
I have a series of dynamically created checkboxes and textboxes on each line of a user form, with a checkbox before each line, when the checkbox is checked/unchecked, I need to change the backcolor on all the textboxes in that row. Each control is named by it's type, then row then column like this CHX_1_1 would be a checkbox on row 1 column 1, and TXT_1_5 would be row 1 column 5. So, if I know what the name of the checkbox is, I have all I need to change the other controls on that row with a simple for-next loop.
I am not quite sure if I understand your question correctly. But it seems to me that it boils down to "which FormControl (linked to a particular procedure) caused this sub to run". If that's the case then you should be able to make use of the
Application.Caller
Here is a short video to demonstrate it's use in a very simple environment:
Here's hopefully a full solution showing how to get the properties from the check boxes:
Create a blank userform and add a command button to it.
Add this code to the form (note - CommandButton1_Click should be updated to the name of the button you added).
Public CHK_Evts As New Collection
Private Sub CommandButton1_Click()
Dim ChkBox As Variant
For Each ChkBox In CHK_Evts
MsgBox ChkBox.Position & vbCr & _
ChkBox.Status
Next ChkBox
End Sub
Private Sub UserForm_Initialize()
Dim tmpCtrl As Control
Dim cmbEvent As clsControlEvents
Dim X As Long
For X = 1 To 10
Set tmpCtrl = frmNameParser.Controls.Add("Forms.Checkbox.1", "Name" & X)
With tmpCtrl
.Left = 6
.Top = X * 20 + 24
.Height = 18
.Width = 150
End With
Set cmbEvent = New clsControlEvents
Set cmbEvent.CHK = tmpCtrl
CHK_Evts.Add cmbEvent, "Name" & X
Next X
End Sub
Create a class called clsControlEvents and add this code:
Public WithEvents CHK As MSForms.CheckBox
Public Property Get Position() As String
Position = CHK.Top
End Property
Public Property Get Status() As String
Status = CHK.Value
End Property
Private Sub CHK_Click()
MsgBox CHK.Name
End Sub
The two GET procedures pass information back to the CommandButton1_Click procedure so it can list information about all check boxes on the form (held in the CHK_EVTS collection).
The CHK_Click procedure gives immediate information about the check box being clicked.
http://www.cpearson.com/excel/classes.aspx

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.

Access 2010 VBA Forms - Automatic Form Resize

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: