As said above, in my following code I get an compiler error telling me there is an invalid identifier. I don't really see the problem, basically it is a very easy code. The problem should be in the lines using the backcolor-Function.
Sub addmaterial()
Dim AMU As UserForm
Set AMU = AddMaterialUserform1
Dim SCU As ComboBox
Set SCU = AMU.SelectComboBoxUserform
Dim APCU As ComboBox
Set APCU = AddMaterialUserform1.AddedPropertiesComboBoxUserform
Dim TextBoxObject As Combobox
Dim i As Integer
SCU.AddItem "Material"
SCU.AddItem "Material Group"
APCU.BorderColor.ColorIndex = 15
For i = 1 To 12
TextBoxObject = "Textbox" & i
AMU.TextBoxObject.BackColor.ColorIndex = 15
Next
AMU.Show
End Sub
You try to assign a String to an Object
TextBoxObject = "Textbox" & i
You can use the AMU.Controls- Collection
Set TextBoxObject = AMU.Controls("Textbox" & i)
If you don't have the reference just the Name.
Or if there is no Collection on other Objects have a look at
CallByName(Object As Object, ProcName As String, _
CallType As VbCallType, Args() As Variant)`
`.
Dim TextBoxObject As String
AMU.TextBoxObject.BackColor.ColorIndex = 15
At a guess it doesn't like you declaring a string variable as the same name as a text box
Related
The single most annoying feature in Excel's built-in VBA editor is—in my opinion—the aggressive autoformatting of the code, which insists on rewriting what I have typed as soon as the cursor leaves the line. It is particularly distressing that the editor collapses all whitespace, thus preventing any meaningful code alignment. For example, if I try to align a sequence of assignments by the equals sign with values aligned by the decimal separator:
price = 10.01
quantity = 3.2
vat = 0.11
the editor inevitably scrambles it by collapsing all spaces:
price = 10.01
quantity = 3.2
vat = 0.11
Is there any way to avoid this kind unwelcome autoformatting?
Assignment cosmetics :-)
There's neither a special VBE property to change the VBE (autoformatting) options directly nor a way to do it programatically. - So afaik VBE irrevocably forces autoformatting upon the user by partial workarounds.
a) Class method
For the sake of the art and just for fun an actually (very) basic class approach to give you a starting idea; assignment arguments are passed as strings allowing any optical formatting - if that's what you really want:
Example call in current module
Sub ExampleCall()
Dim x As New cVars
x.Add "price = 11.11" ' wrong assignment
'...
x.Add "price = 10.01" ' later correction
x.Add "quantity = 1241.01"
x.Add "vat = 0.11"
Debug.Print "The price is $ " & x.Value("price")
End Sub
Class module cVars
Option Explicit
Private dict As Object
Sub Add(ByVal NewValue As Variant)
'split string tokens via equal sign
Dim tmp
tmp = Split(Replace(Replace(NewValue, vbTab, ""), " ", "") & "=", "=")
'Identify key and value item
Dim myKey As String, myVal
myKey = tmp(0)
myVal = tmp(1): If IsNumeric(myVal) Then myVal = Val(myVal)
'Add to dictionary
If dict.exists(myKey) Then
dict(myKey) = myVal
Else
dict.Add myKey, myVal
End If
'Debug.Print "dict(" & myKey & ") =" & dict(myKey)
End Sub
Public Property Get Value(ByVal myVarName As String) As Variant
'get variable value
Value = dict(myVarName)
End Property
Private Sub Class_Initialize()
'set (late bound) dict to memory
If dict Is Nothing Then Set dict = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set dict = Nothing
End Sub
Edit #1 as of 3/3 2021
b) Rem Evaluation method
Once again only for the sake of the art a way to read assignments entered into outcommented code lines via, yes via Rem (heaving a deep sigh for this archaic use originating from former Basic times) as it allows to format data with any wanted spaces or tabs and won't be mixed up hopefully with current outcommentings via apostrophe '.
This Test procedure only needs the usual declarations plus some assignment calls as well as the mentioned Rem part. Two simple help procedures get code lines, analyze them via a dictionary class cVars and eventually assign them.
Note that the following example
needs a library reference to Microsoft Visual Basic Extensibility 5.3 and
uses the unchanged class cVars of section a) simply to avoid rewriting it.
Option Explicit
Private Const THISMODULE As String = "Module1" ' << change to current code module name
Sub Test() ' procedure name of example call
'Declare vars
Dim price As Double: Assign "price", price
Dim quantity As Double: Assign "quantity", quantity
Dim vat As Double: Assign "vat", vat
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Enter assignments via Rem(ark)
'(allowing any user defined formatting therein)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Rem price = 10.01
Rem quantity = 1241.01
Rem vat = 0.11
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Debug.Print quantity & " à $" & price & " = " & Format(quantity * price, "$#,##0.00")
End Sub
Help procedure Assign evaluating Rem codelines in procedure Test
Sub Assign(ByVal myVarName As String, ByRef myvar)
Const MyProc As String = "Test"
Dim codelines
getCodelines codelines, THISMODULE, ProcedureName:=MyProc
'Debug.Print Join(codelines, vbNewLine)
Dim x As New cVars ' set class instance to memory
Dim line As Variant, curAssignment
For Each line In codelines
curAssignment = Split(line, "Rem ")(1) ' remove Rem prefix from codelines
If curAssignment Like myVarName & "*" Then
x.Add curAssignment
myvar = x.Value(myVarName)
End If
Next
End Sub
Help procedure getCodelines
Called by above proc Assign. Returns the relevant Rem Codelines from the calling procedure Test. - Of course it would have been possible to filter only one codeline.
Sub getCodelines(ByRef arr, ByVal ModuleName As String, ByVal ProcedureName As String)
Const SEARCH As String = "Rem "
'a) set project
Dim VBProj As Object
Set VBProj = ThisWorkbook.VBProject
If VBProj.Protection = vbext_pp_locked Then Exit Sub ' escape locked projects
'b) set component
Dim VBComp As Object
Set VBComp = VBProj.VBComponents(ModuleName)
Dim pk As vbext_ProcKind
'd) get relevant code lines
With VBComp.CodeModule
'count procedure header lines
Dim HeaderCount As Long: HeaderCount = .ProcBodyLine(ProcedureName, pk) - .ProcStartLine(ProcedureName, pk)
'get procedure code
Dim codelines
codelines = Split(.lines(.ProcBodyLine(ProcedureName, pk), .ProcCountLines(ProcedureName, pk) - HeaderCount), vbNewLine)
'filter code lines containing "Rem" entries
codelines = Filter(codelines, SEARCH, True)
End With
'return elements
arr = codelines
End Sub
Don't forget to integrate the class module CVars from section a)!
I have the following code:
Sub AddSources()
Dim pubPage As Page
Dim pubShape As Shape
Dim hprlink As Hyperlink
Dim origAddress() As String
Dim exportFileName As String
exportFileName = "TestResume"
Dim linkSource As String
linkSource = "TestSource2"
Dim hyperLinkText As TextRange
For Each pubPage In ActiveDocument.Pages
For Each pubShape In pubPage.Shapes
If pubShape.Type = pbTextFrame Then
For Each hprlink In pubShape.TextFrame.TextRange.Hyperlinks
If InStr(hprlink.Address, "http://bleaney.ca") > 0 Then
hyperLinkText = hprlink.Range
origAddress = Split(hprlink.Address, "?source=")
hprlink.Address = origAddress(0) + "?source=" + linkSource
hprlink.Range = hyperLinkText
End If
Next hprlink
End If
Next pubShape
Next pubPage
ThisDocument.ExportAsFixedFormat pbFixedFormatTypePDF, "C:\" + exportFileName + ".pdf"
End Sub
I am getting the "Object variable or With block variable not set (Error 91)" error on the line with hyperLinkText = hprlink.Range. When I debug I can see that hprlink.Range does have a value. Any thoughts what I'm doing wrong?
As I wrote in my comment, the solution to your problem is to write the following:
Set hyperLinkText = hprlink.Range
Set is needed because TextRange is a class, so hyperLinkText is an object; as such, if you want to assign it, you need to make it point to the actual object that you need.
I would like to access the value of a string when declaring new variables so that I can declare new variables within a loop.
I have tried val(), creating a function. An simplified version of my problem can be found in the code below.
Function StudentValue(x As String) As String
StudentValue = x
End Function
Public Sub TEST()
Dim i As Integer
Dim strName As String
Dim n As Integer
n = 20
For i = 1 To n
strName = "Variable" & CStr(i)
'The problem occurs with the next two lines,
'once active they create a string with the name 'strName' and not the
'value of the string eg 'Variable1', 'Variable2', ect
'Attempt1
'Dim strName As String
'Attempt2
'Dim NameFunction(strName) As String
Next i
End Sub
The errors are as follows:
Dim strName As String results in "compile error: Duplicate declaration in current scope"
Dim NameFunction(strName) As String results in "compile error: Constant expression required"
Is there a function that allows you to access the value of a string when declaring variables?
Thank you in advance!
You are getting "Duplicate declaration" Error because you are trying to declare a variable by the same name.
You are getting the error "Constant expression required" Error because Dim XYZ() as string is the syntax for declaring an array. And the value inside the brackets specifies the size of the array and must be constant.
Here is a link on how to use arrays.
Use Option Explicit, it will help you solve problems before they are problems.
Here is your code using arrays.
Option Explicit
Function StudentValue(x As String) As String
StudentValue = CStr(x)
End Function
Public Sub TEST()
Const MaxNumNames As Integer = 20
Dim i As Integer
Dim strNames(1 To MaxNumNames) As String
For i = 1 To MaxNumNames
'This will populate the array of names
strNames(i) = "Variable" & CStr(i)
'To use the name in the loop
Debug.Print "In Loop:" & strNames(i)
Next i
'To use the name outside the loop (Show 5th name)
Debug.Print "Outside Loop: " & strNames(5)
' To use the name in your function outside the loop (Using 2nd Name)
Debug.Print "Using Function: " & StudentValue(strNames(2))
End Sub
Program: Excel 2016.
I have a sheet with a lot of shapes. Each of them has its own specific name and most of them are label. I want to change their caption property, but i can't find a way but calling them one by one like this:
LblLabel_1.Caption = ...
LblLabel_2.Caption = ...
LblLabel_3.Caption = ...
Instead i was looking for something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01).Caption = ...
Next
This one will result in error 438, basically saying Caption is not avaiable for this object. It still target the object, since this code:
Debug.print Shapes("LblLabel_" & BytCounter01).Name
will return me its name.
Looking for a solution:
-i've tried Controls("LblLabel_" & BytCounter01) instead of Shapes("LblLabel_" & BytCounter01) but it won't work since Controls is only for userforms, not for sheets;
-i've tried Shapes("LblLabel_" & BytCounter01).TextFrame.Characters.Text but it returns error 438 again;
-since the label is a part of a group, i've tried both
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption
and
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text
but got 438 again.
Is there really no way to easily target a specific label on a sheet and change his caption?
Thank you.
EDIT: thanks to Excelosaurus, the problem is solved. Since my labels are ActiveX Controls i have to use something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Caption = ...
Next
You can check his response and comments for more details. Thanks again Excelosaurus!
To change the textual content of a shape, use .TextFrame2.TextRange.Text as shown below:
shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
where shtShapes is the name of your worksheet's object as seen from the Visual Basic Editor in the Project Explorer,
sShapeName is a string variable containing the name of the target shape, and
sShapeCaptionis a string variable containing the desired caption.
A code example follows. I've thrown in a function to check for a shape's existence on a worksheet, by name.
Option Explicit
Public Sub SetLabelCaptions()
Dim bCounter As Byte
Dim sShapeName As String
Dim sShapeCaption As String
For bCounter = 1 To 255
sShapeName = "LblLabel_" & CStr(bCounter)
If ShapeExists(shtMyShapes, sShapeName) Then
sShapeCaption = "Hello World " & CStr(bCounter)
shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
Else
Exit For
End If
Next
End Sub
Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
Dim boolResult As Boolean
Dim shpTest As Excel.Shape
On Error Resume Next
Set shpTest = pshtHost.Shapes(psShapeName)
boolResult = (Not shpTest Is Nothing)
Set shpTest = Nothing
ShapeExists = boolResult
End Function
The result should look like this:
You can't assign a Caption to a Shape. (Shapes don't have Captions). One approach is to loop over the Shapes and build a little table to tell you what to loop over next:
Sub WhatDoIHave()
Dim kolumn As String, s As Shape
Dim i As Long, r As Range
kolumn = "Z"
i = 1
For Each s In ActiveSheet.Shapes
Set r = Cells(i, kolumn)
r.Value = i
r.Offset(, 1).Value = s.Name
r.Offset(, 2).Value = s.Type
r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
i = i + 1
Next s
End Sub
Which for my sample produced:
Seeing that I have both Forms and ActiveX (OLE) Controls, I know what to loop over next. I then refer to the Control by number and assign a Caption if appropriate.
I'm getting said error in using VBA in Excel on the following code:
Private Sub XMLGen(mapRangeA, mapRangeB, ticketSize, mapping)
Dim fieldOneArr As Variant
Dim fieldTwoArr As Variant
Dim row As Long
Dim column As Long
Dim infoCol As Long
Dim endInfo As Long
Dim objDom As DOMDocument
Dim objNode As IXMLDOMNode
Dim objXMLRootelement As IXMLDOMElement
Dim objXMLelement As IXMLDOMElement
Dim objXMLattr As IXMLDOMAttribute
Set ws = Worksheets("StockData")
Dim wsName As String
Set objDom = New DOMDocument
If ticketSize = 8 Then
wsName = "A7Tickets"
ElseIf ticketSize = 16 Then
wsName = "A8Tickets"
Else
wsName = "A5Tickets"
End If
Set ps = Worksheets(wsName)
'create processing instruction
Set objNode = objDom.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
objDom.appendChild objNode
'create root element
Set objXMLRootelement = objDom.createElement("fields")
objDom.appendChild objXMLRootelement
'create Attribute to the Field Element and set value
Set objXMLattr = objDom.createAttribute("xmlns:xfdf")
objXMLattr.NodeValue = "http://ns.adobe.com/xfdf-transition/"
objXMLRootelement.setAttributeNode objXMLattr
infoCol = 1
fieldOneArr = Worksheets(mapping).range(mapRangeA)
fieldTwoArr = Worksheets(mapping).range(mapRangeB)
For row = 1 To UBound(fieldOneArr, 1)
For column = 1 To UBound(fieldOneArr, 2)
'create Heading element
Set objXMLelement = objDom.createElement(fieldOneArr(row, column))
objXMLRootelement.appendChild objXMLelement
'create Attribute to the Heading Element and set value
Set objXMLattr = objDom.createAttribute("xfdf:original")
objXMLattr.NodeValue = (fieldTwoArr(row, column))
objXMLelement.setAttributeNode objXMLattr
objXMLelement.Text = ps.Cells(row, infoCol)
infoCol = infoCol + 1
endInfo = endInfo + 1
If endInfo = 4 Then
infoCol = 1
End If
Next column
Next row
'save XML data to a file
If ticketSize = 2 Then
objDom.Save ("C:\ExportTestA5.xml")
MsgBox "A5 XML created"
ElseIf ticketSize = 8 Then
objDom.Save ("C:\ExportTestA7.xml")
MsgBox "A7 XML created"
Else
objDom.Save ("C:\ExportTestA8.xml")
MsgBox "A8 XML created"
End If
End Sub
When I hit debug it points to this line:
fieldOneArr = Worksheets(mapping).range(mapRangeA)
I know that .Range is supposed to be upper case but it keeps on setting it to lower case automatically whenever I correct it.
This code is meant to create an XML file and then write the details from the chosen worksheet (based on the ticketSize variable) into the correct XML fields. Hence I have a mapping worksheet from which I write the field and attribute names, and then write in the info from the correct ticket size worksheet into the text property of the element.
You should define the types of your function parameters, in this case mapRangeA As String. Office object methods and properties are often not very helpful with their error messages, so it's better to have a type mismatch error if you have a problem with a parameter.