This question already has answers here:
How to get a name of control by name?
(2 answers)
Closed 8 years ago.
I have quit a lot ComboBox objects, and I am trying to display the value of the ComboBox by looping through them:
For i=1 to 100
MsgBox ("ComboBox" & i & ".Text")
Next
Of course this code is not working because of the quotes, but when I remove them, then I have a compilation error.
How do I do this?
The OP does not state if the objects in question are ActiveX or Form Control objects.
To handle both object types, and if the objects names are not ComboBox*, try this
Sub Demo()
Dim ws As Worksheet
Dim shp As Shape
Dim cb As ComboBox
Set ws = ActiveSheet
For Each shp In ws.Shapes
With shp
Select Case .Type
Case msoFormControl
If .FormControlType = xlDropDown Then
If .ControlFormat.Value = 0 Then
MsgBox .Name & " = "
Else
MsgBox .Name & " = " & .ControlFormat.List(.ControlFormat.Value)
End If
End If
Case msoOLEControlObject
If .OLEFormat.progID = "Forms.ComboBox.1" Then
Set cb = .OLEFormat.Object.Object
MsgBox cb.Name & " = " & cb.Value
End If
End Select
End With
Next
End Sub
This works for me. Assumes your comboboxes' names are indeed ComboBox1 through ComboBox100.
Dim cb As ComboBox
Dim i As Long
For i = 1 To 100
Set cb = Sheet1.Shapes("ComboBox" & i).OLEFormat.Object.Object ' Ouch!
MsgBox cb.Text
Next i
The .Object.Object trick I got from here.
Related
I am attempting to write a vba loop that will detect the value of all ActiveX textboxes on the slide. However I am have trouble writing the code for the "variable" in the textbox reference. For example TextBox(i) needs to be referenced in the loop. Where i is an integer I set the value to.
Dim i as Integer
For i = 1 to 4
If IsNull(Slide1.Shapes.("TextBox" & i).Value) = True
Then (Slide1.Shapes.("TextBox" & i).Value) = 0
Else: ...
Next i
However this script doesn't work and I have been unable to locate a source for how to properly code this variable portion of script. There has been some talk of using Me.Controls however I am not creating a form. Would anyone be willing to share what the error is here in my script?
This will put the value of i into TextBox i. Should get you started, I think.
Sub Example()
Dim oSh As Shape
Dim i As Integer
On Error Resume Next
For i = 1 To 4
Set oSh = ActivePresentation.Slides(1).Shapes("TextBox" & CStr(i))
If Err.Number = 0 Then ' shape exists
oSh.OLEFormat.Object.Text = CStr(i)
End If
Next i
End Sub
#Steve Rindsberg you had the correct code. Thank you. Here was the final script to obtain the value, and set the value if blank.
For i = 1 To 4
'set oSh to TextBox1, TextBox2, TextBox3... etc.
Set oSh = ActivePresentation.Slides(1).Shapes("TextBox" & CStr(i))
'set myVar to value of this TextBox1, TextBox2...
myVar = oSh.OLEFormat.Object.Value
If myVar = "" Then _
ActivePresentation.Slides(1).Shapes("Text" & CStr(i)).OLEFormat.Object.Value = 0 _
Else: 'do nothing
'clear value of myVar
myVar = ""
'start on next integer of i
Next i
I want to write a macro that will pick a particular value (in my case, stored in cell A1) from a dropdown list (in my case, in cell D6).
Here's what I have so far:
sr_par2 = Array ("TEXT", 'TEXT2", "TEXT3")
sr = Range("A1").Value
(...)
Dim i As Integer
i = 0
Range("D6").Select
Do While (sr <> ActiveCell.FormulaR1C1)
Range("D6").Select
ActiveCell.FormulaR1C1 = sr_par2(i)
i = i + 1
Loop
Is this what you are trying? I have commented the code so that you will not have a problem understanding it. Still if you do then simply ask :)
Sub Sample()
Dim ws As Worksheet
Dim rngIn As Range, rngOut As Range
Dim MyAr
Dim sFormula As String
Dim i As Long
'~~> Replace this with the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Set your input and output range here
Set rngIn = .Range("A1")
Set rngOut = .Range("D6")
'~~> Get the validation list if there is one
On Error Resume Next
sFormula = rngOut.Validation.Formula1
On Error GoTo 0
If sFormula = "" Then
'~~> If no validation list then directly populate the value
rngOut.Value = rngIn.Value
Else
'validation list TEXT1,TEXT2,TEXT3
MyAr = Split(sFormula, ",")
'~~> Loop through the list and compare
For i = LBound(MyAr) To UBound(MyAr)
If UCase(Trim(rngIn.Value)) = UCase(Trim(MyAr(i))) Then
rngOut.Value = MyAr(i)
Exit For
End If
Next i
'~~> Check if the cell is still blank. If it is then it means that
'~~> Cell A1 has a value which is not part of the list
If Len(Trim(rngOut.Value)) = 0 Then
MsgBox "The value in " & rngOut.Address & _
" cannot be set as the value you are copying is not part of the list"
End If
End If
End With
End Sub
If I understood correctly, this should do what you want :
sr_par2 = Array("TEXT", "TEXT2", "TEXT3")
sr = Range("A1").Value
Dim i As Integer
i = 0
On Error GoTo Handler
Do While (sr <> sr_par2(i))
i = i + 1
Loop
Range("D6").FormulaR1C1 = sr_par2(i)
Exit Sub
Handler:
MsgBox "Value not in the list", vbCritical + vbOKOnly, "Value not found"
I have a Word Userform where I add text boxes dynamically. The code then puts information from the textboxes to bookmarks which are picture filenames. It is all dynamic in that you enter how many textboxes you need and it then adds them to the userform and the text in the document. I left this last part of code out because its very long and not needed at this point.
I am attempting to put this first part of my code into a "For Loop" but I have been having a lot of difficulty doing so. The second part of my code I am providing has a textbox counter I trying to tie into it.
Right now my code works if I enter 10 into a textbox called "Amount" which you see throughout the code. I need to be able to enter any number.
If you think the entire code will help let me know and I will add it instead. I have been able to get everything else to work but for some reason this has had me stumped for days.
Need "For loop" implemented
Sub CommandButton1_Click()
Dim Textbox As Object
Dim Textbox1 As Object
Dim Textbox2 As Object
Dim Textbox3 As Object
Dim Textbox4 As Object
Dim Textbox5 As Object
Dim Textbox6 As Object
Dim Textbox7 As Object
Dim Textbox8 As Object
Dim Textbox9 As Object
Dim Textbox10 As Object
Dim TBs(9) As Object
Set TBs(0) = UserForm1.Controls("TextBox_1"): Set TBs(1) = UserForm1.Controls("TextBox_2"): Set TBs(2) = UserForm1.Controls("TextBox_3")
Set TBs(3) = UserForm1.Controls("TextBox_4"): Set TBs(4) = UserForm1.Controls("TextBox_5"): Set TBs(5) = UserForm1.Controls("TextBox_6")
Set TBs(6) = UserForm1.Controls("TextBox_7"): Set TBs(7) = UserForm1.Controls("TextBox_8"): Set TBs(8) = UserForm1.Controls("TextBox_9")
Set TBs(9) = UserForm1.Controls("TextBox_10"):
Dim i
For i = 0 To Amount - 1
With ActiveDocument
If .Bookmarks("href" & i + 1).Range = ".jpg" Then
.Bookmarks("href" & i + 1).Range _
.InsertBefore TBs(i)
.Bookmarks("src" & i + 1).Range _
.InsertBefore TBs(i)
.Bookmarks("alt" & i + 1).Range _
.InsertBefore TBs(i)
End If
End With
Next
End Sub
TextBox Counter
Private Sub AddLine_Click()
Dim theTextbox As Object
Dim textboxCounter As Long
For textboxCounter = 1 To Amount
Set theTextbox = UserForm1.Controls.Add("Forms.TextBox.1", "Test" & textboxCounter, True)
With theTextbox
.Name = "TextBox_" & textboxCounter
.Width = 200
.Left = 70
.Top = 30 * textboxCounter
End With
Next
End Sub
Very new at VBA, I need something that sounds simple but I lack the knowledge or terminology to correctly research how to do this.
I need a way to loop through a column (we'll say D) to find value (X) and prompt a dropdown box from range (T2:T160) to replace value X for each individual occurance of X in rows rows 1 to 10000.
At the same for each time X is found, the value in that row for column B needs to be displayed (the user will query an external application to determine which of the values from the range needs to be set for that unique column B value)
1 b
2 y
3 x
4 t
5 x
and end like this
1 b
2 y
3 q
4 t
5 p
I setup my data like this:
Main code:
Sub findReplace()
Dim iReply As Integer
Dim strName As String
strName = InputBox(Prompt:="Enter Text to Search in Column D", Title:="Search Text", Default:="Enter value to find")
If strName = "Enter value to find" Or strName = vbNullString Then
Exit Sub
Else
For Each cell In Range("D1:D5")
If cell.Value = Trim(strName) Then
'Prompt to see if new value is required
iReply = MsgBox(Prompt:="Found " & strName & vbCrLf & "Value in column B is: " & cell.Offset(0, -2).Value & vbCrLf & "Do you wish to replace it?", _
Buttons:=vbYesNoCancel, Title:="UPDATE MACRO")
'Test response
If strName = "Your Name here" Or _
strName = vbNullString Then
Exit Sub
ElseIf iReply = vbYes Then
'Get new value
UserForm1.Show
ValueSelected = UserForm1.ComboBox1.Value
Unload UserForm1
If ValueSelected = vbNullString Or ValueSelected = "" Then
Exit Sub
Else
'Replace value
cell.Value = ValueSelected
End If
ElseIf iReplay = vbCancel Then
Exit Sub
End If
End If
Next cell
End If
End Sub
Setup a UserForm1 to display a drop down list to provide the user a selection option. Code behind form looks like this: (buttons have to be named the same to work correctly)
Private Sub bnt_Cancel_Click()
Unload Me
End Sub
Private Sub btn_Okay_Click()
Me.Hide
End Sub
Private Sub UserForm_Initialize()
'Populate dropdown list in userform
Dim rng As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
For Each rng In ws.Range("T1:T10")
Me.ComboBox1.AddItem rng.Value
Next rng
End Sub
When you run it you'll get this sequence of popups:
I said no to the second replacement value so now my spread sheet looks like this:
I am a bit new to Outlook forms, but not to VBA overall - nor HTML/Web design of forms. However, my problem is finding a way to combine the two.
I am trying to design a form for users to fill out, and based on what they fill out in drop-down box's, it will then tell them what we want them to attach in the email. Currently we have this done in Excel, based on dropbox's it then VLOOKUPS to the 2nd Spreadsheet that contains the forms required.
Is there anyway I can bring in the Excel with the VLOOKUP behind the scenes in my VBA Outlook Form so that it can look-up what attachments we want the user to do? Otherwise, it would be a TON of SELECT CASE statements in VBA =/
This seems to the do the trick for me.
Some of it I have cobbled together from sites like this, the rest has been created by myself from scratch.
When I click my button:
An input box appears, which is the value that will be looked up in the spreadsheet.
it looks in the range (specified in the code), for a match
returns the value, two columns to the left of it.
when it finds a match it puts it in the Subject line in Outlook.
Dim jobno As String
Dim Proj As String
Sub Test()
jobno = InputBox("Job Number?", "Test")
GetNameFromXL
If jobno <> "" Then
Set myItem = Application.CreateItem(0)
If Proj <> "" Then
myItem.Subject = jobno & " - " & Proj & " - " & Format(Date, "dd.mm.yy")
Else
myItem.Subject = jobno & " - " & Format(Date, "dd.mm.yy")
End If
myItem.Display
Else
Exit Sub
End If
End Sub
Sub GetNameFromXL()
'Late binding. No reference to Excel Object required.
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Set xlApp = CreateObject("Excel.Application")
'Open the spreadsheet to get data
Set xlWB = xlApp.Workbooks.Open("X:\...\FILENAME.xlsx") ' <-- Put your file path and name here
Set xlWS = xlWB.Worksheets(1) ' <-- Looks in the 1st Worksheet
Debug.Print "-----Start of 'For Each' loop"
For Each c In xlWS.Range("A6:A100") 'Change range to value you want to 'VLookUp'
Proj = c.Offset(0, 2).Value 'This looks at the 2nd column after the range above
Debug.Print c & Proj
If jobno = c Then
Debug.Print "-----Match Found: " & jobno & " = " & Proj
GoTo lbl_Exit
Else
End If
Next c
Debug.Print "-----End of For Each loop"
MsgBox jobno & " not found in WorkBook."
'Clean up
Set xlWS = Nothing
Set xlWB = Nothing
Set c = Nothing
Proj = ""
xlApp.Quit
Set xlApp = Nothing
lbl_Exit:
Exit Sub
End Sub