MS Access: Multi ListBox get values - vba

I have a listbox on a form that contains 6 values. The user is allowed to select multiple values at once. For each value selected I want to assign this value to a variable.
My listbox is called: lstFilterUnits
The listbox contents are as follows:
Blue, Red, Green, Yellow, Orange, White
I understand that the following is associated with each colour:
Forms("Form1").lstFilterUnits.Selected(0) 'Blue Selected
Forms("Form1").lstFilterUnits.Selected(1) 'Red Selected
Forms("Form1").lstFilterUnits.Selected(2) 'Green Selected
Forms("Form1").lstFilterUnits.Selected(3) 'Yellow Selected
Forms("Form1").lstFilterUnits.Selected(4) 'Orange Selected
Forms("Form1").lstFilterUnits.Selected(5) 'White Selected
I have attempted to do this using the below code in the listbox on click event:
As you can see I had to hard code the value assigned to the vUnit variable as anytime I try get the value associated with the list box with either of the lines commented out it doesn't work.
Dim vUnit As String
If Forms("Form1").lstFilterUnits.Selected(0) = True Then
vUnit = "Blue
MsgBox (vUnit)
'MsgBox "You selected " & lstFilterUnits.Value 'Returns null value
'MsgBox "You selected " & lstFilterBusinessUnits.SelectedValue 'Returns Compile error
ElseIf Forms("Form1").lstFilterUnits.Selected(1) = True Then
vUnit = vUnit & ", Red'"
MsgBox (vUnit)
End If
So for the above code I can't seem to assign the value associated with the selected item to a variable. I also want to me able to display multiple values in the variable if they are selected, however if I select more than one value using the above method it will only go into the first if statement that is true, due to this I think I should be using some sort of a loop to assign the variable multiple values but I'm new to VBA and d not know how to do this.
Any help would be appreciated, I think this is probably a simple task that I am overthinking.
EDIT:
After searching online I finally found something that is kind of doing what I need. However the output is also outputting the index number of the listbox. The code I found is below. I've tried playing around with it but can't seem to achieve my desired output.
The below code will output the following:
'1 , 'Blue', '2 'Red', 3 ,'Green',
Whereas I want it to output:
'Blue','Red', 'Green',
Does anyone know how I can achieve this? I've tried changing the column to both only i and J and this didn't seem to work. I've never worked with arrays in VBA before so will admit I don't understand the code fully and the form I found it on didn't explain the code, it was just providing a solution for another user.
Dim i As Long
Dim J As Long
Dim Msg As String
Dim arrItems() As String
ReDim arrItems(0 To lstFilterUnits.ColumnCount - 1)
For J = 0 To lstFilterUnits.ListCount - 1
If lstFilterUnits.Selected(J) Then
For i = 0 To lstFilterUnits.ColumnCount - 1
arrItems(i) = lstFilterUnits.Column(i, J)
Next i
Msg = Msg & "'" & Join(arrItems, " , '") & "', "
End If
Next J
MsgBox Msg

Use the .ItemsSelected collection. It already has all the items.
EXAMPLE:
Sub Example()
dim ctl as Control
Set ctl = Forms("Form1").lstFilterUnits
Dim varItm As Variant
For Each varItm In ctl.ItemsSelected
Debug.Print ctl.ItemData(varItm)
Next varItm
End Sub
SOURCE: https://learn.microsoft.com/en-us/office/vba/api/access.listbox.itemsselected

Have a try on it.
Private Sub lstFilterUnits_Click()
Dim ctl As Control
Dim varItm As Variant
Dim SelectedColor As String
Set ctl = Forms!Form1!lstFilterUnits
For Each varItm In ctl.ItemsSelected
SelectedColor = SelectedColor & vbCrLf & ctl.ItemData(varItm) 'This for each color in each line
'SelectedColor = SelectedColor & "," & ctl.ItemData(varItm) ' This line for comma separated color
Next varItm
MsgBox SelectedColor
End Sub

Related

Printing a different value in a text box on multiple copies

I have a button that prints a form on the current record.
The form contains a combobox with something like: 123005TEST
This combobox is a lookup to another textbox which is a combination of three text boxes(on a different form):
=([OrderNr] & (""+[Aantal]) & "" & [SapArtNr])
OrderNr is 12300 and Aantal is 5 and SapArtNr is TEST, creating: 123005TEST
My question is, when I click print, is it possible to print a certain amount of copies based on Aantal 5, so printing 5 copies.
And here comes the tricky part.
To have each printed copy a different value in the combobox, so the first copy would have this written in the combobox on the printed paper: 123001TEST and copy two would be 123002TEST and so on, until 5.
I didn't understand which textbox will receive the sequential text. So I put a dummy in the example code:
Option Explicit
Private Sub cmdPrintIt_Click()
Dim strOrderNr As String
Dim strAantal As String
Dim strSapArtNr As String
Dim intHowManyCopies As Integer
Dim intCopy As Integer
Dim strToTextBox As String
strOrderNr = Me.OrderNr.Text
strAantal = Me.Aantal.Text
strSapArtNr = Me.SapArtNr.Text
On Error Resume Next
intHowManyCopies = CInt(strAantal)
On Error GoTo 0
If intHowManyCopies <> 0 Then
For intCopy = 1 To intHowManyCopies
strToTextBox = strOrderNr & CStr(intCopy) & strSapArtNr
Me.TheTextBoxToReceiveText.Text = strToTextBox
'put your code to print here
Next
Else
MsgBox "Nothing to print! Check it."
End If
End Sub

VBA convert textbox entry to an integer

I am trying to convert a textbox entry to an integer:
Dim cplayers() As Variant: cplayers = Array ("Danny", "Freddy", "Billy", "Tommy")
Dim i As Integer
i = CInt(TextBox3)
MsgBox (cplayers(i) & " is on first base.")
When I run it now, the message box always reads "Danny is on first base." so it must be reading the textbox as empty and assuming the entry is 0 then. What should I change?
You can use an ActiveX Text Box to import the value.
To Insert: Developer Tab > Insert > ActiveX Controls > Text Box (ActiveX Control)
You can then extract your value as such:
Option Explicit
Sub Test()
Dim cplayers() As Variant: cplayers = Array("Danny", "Freddy", "Billy", "Tommy")
Dim i As Integer
i = TextBox1.Value
MsgBox cplayers(i) & " is on first base."
End Sub
You could also refer to the object but that would be overkill here.
The field that holds the actual entry for the Textbox seems to be "TextBox3.text"
Dim cplayers() As Variant: cplayers = Array ("Danny", "Freddy", "Billy", "Tommy")
Dim i As Integer
i = CInt(TextBox3.text)
MsgBox (cplayers(i) & " is on first base.")
There is also a check that can help you to prevent wrong inputs in the calculations. You can use isNumeric() to determine if the entered value is a valid number like If IsNumeric(TextBox3.text) Then

VBA Replace Code in Another Module Using VBA Code

I have a line of code in one module:
City = "Paris"
Within a separate module I need to change the name of the city based on what a user selects from a dropdown. I have code that will change the entire line as follows:
Sub ChangeUserCity()
Call Dictionary.CityLocation
Dim UserChosenCity As String
Dim SL As Long, EL As Long, SC As Long, EC As Long
Dim S As String
Dim Found As Boolean
ComboBoxList = Array(CStr(CityName)) 'This is the name of the combodropdown box with the list of city names.
For Each Ky In ComboBoxList
'On Error Resume Next
UserChosenCity = dict4.Item(Ky)(0) 'This refers to the dictionary that has the list of city names. It grabs the string (the name of the city).
With ActivePresentation.VBProject.VBComponents("Dictionary").CodeModule
SL = 1
SC = 1
EL = -1
EC = -1
Found = .Find("City = " & """" & "Paris" & """", SL, SC, EL, EC, True, False, False)
If Found = True Then
S = .Lines(SL, 1)
S = Replace(S, "City = " & """" & "Paris" & """", "City= " & """" & UserChosenCity & """")
.ReplaceLine SL, S
End If
End With
Next Ky
End Sub
The problem with the way this code works is that the city name will not always be "Paris". It could be any string (i.e. any city name). So what I really need the code to do is just replace the city name between the quotes with the UserChosenCity. Any idea on how to accomplish this? Thank you!
Add a combo box and a text box to your slide.
With ComboBox1 and TextBox1 on Slide 1 this code moves the value from the combobox to the the textbox:
Private Sub ComboBox1_Change()
Dim oComboBox As ComboBox
Dim oTextBox As TextBox
Set oComboBox = ActivePresentation.Slides("Slide1").Shapes("ComboBox1").OLEFormat.Object
Set oTextBox = ActivePresentation.Slides("Slide1").Shapes("TextBox1").OLEFormat.Object
oTextBox.Value = oComboBox.Value
'or
Slide1.TextBox1.Value = Slide1.ComboBox1.Value
End Sub
Note: Powerpoint isn't my forte so there may be a "proper" way to store values in PPT.
You can now retrieve the value from the textbox after the presentation has been saved, closed and re-opened (saying that - the combobox also retained the value when I re-opened it) and use that value in elsewhere in your code.

How to correctly set the list property? (Error 381)

I have created a listbox which can be filtered according to keyword in textbox. It works if I do it normally. However, it stopped working when the list is a dependent source. (The listbox value is like INDIRECT() of F1 and I'm trying to filter that INDIRECT list)
I have 3 lists as shown in the image (A, B, D). D is a list of A without duplicates. the listbox("lbxCustomers") in Userform2 uses a dependent rowsource according to word selected at Cell F2. [It works until here]
The values in the listbox will be filtered according to keyword in textbox("tbxFind"). I'm getting an error at this line ".List = vaCustNames". I tried to change it into a normal range (sheet1.range(...)) and it works but the list is not a dependent list of F1.
image
Private Sub UserForm_Initialize()
Me.lbxCustomers.RowSource = Range("F2").Value
End Sub
Private Sub tbxFind_Change()
Dim i As Long
Dim sCrit As String
Dim vaCustNames As Variant
vaCustNames = Range("F2").Value
Debug.Print Range("F2").Value
sCrit = "*" & UCase(Me.tbxFind.Text) & "*"
With Me.lbxCustomers
.RowSource = ""
'Start with a fresh list
.List = vaCustNames
'.List = Sheet1.Range("B2:B13").Value 'tested with range and worked
For i = .ListCount - 1 To 0 Step -1
'Remove the line if it doesn’t match
If Not UCase(.List(i)) Like sCrit Then
.RemoveItem i
End If
Next i
End With
End Sub

RichTextBox Highlighting

Goal
Programmatically highlight part of a string contained in a RichTextBox based on what is selected in a DataGridView.
See screenshot for a more visual example
As you can see, when an Option type (EC - Electrical) is selected, its options are displayed in another DataGridView to the right. From there, the user can check the ones he wishes to have included in the Conveyor Function Summary (Photoeye in this case) and it gets highlighted.
Code Used
This method is executed every time the Option Type DataGridView has a selectionchanged event.
Private Sub SummaryOptionsHighlight()
Dim strToFind As String = ""
Dim textEnd As Integer = rtbSummary.TextLength
Dim index As Integer = 0
Dim lastIndex As Integer = 0
'Builds the string to find based on custom classes - works fine
For Each o As clsConveyorFunctionOptions In lst_Options
If o.Included Then
If strToFind.Length <> 0 Then strToFind += ", "
If o.Optn.IsMultipleQty And o.Qty > 0 Then
strToFind += o.Optn.Description & " (" & o.Qty & "x)"
Else
strToFind += o.Optn.Description
End If
End If
Next
'Retrieves the last index of the found string: ex. Photoeye (3x)
lastIndex = rtbSummary.Text.LastIndexOf(strToFind)
'Find and set the selection back color of the RichTextBox
While index < lastIndex
rtbSummary.Find(strToFind, index, textEnd, RichTextBoxFinds.None)
rtbSummary.SelectionBackColor = SystemColors.Highlight
index = rtbSummary.Text.IndexOf(strToFind, index) + 1
End While
End Sub
Problem
What's going on isn't a highlight but more of a backcolor being set to that selection. The reason I say this is because when I click in the RichTextBox to indicate that it has focus, it doesn't clear the highlighting. Perhaps there is an actual highlight instead of a backcolor selection?
See the difference:
Selection Back Color:
Highlighting:
to highlight, you just need to do this:
if richtextbox1.text.contians("photoeye") then
richtextbox1.select("photoeye")
end if
this should work for what you are trying to do