Change the font of form and usercontrol( .frm and .ctl ) at runtime - user-controls

I have a VB 6 Add-in that adds all the projects to a project group, iterates through each of the component of those projects, and if a form or usercontrol is found then changes its properties.
The properties are defined by the user. If user wants to change the height of all the forms or usercontrol then the code snippet is as follows
Private Sub Update_ButtonClick()
'..declaring all the variables here
' VBInstance is initialized to VBIDE.VBE when the add-in is loaded
For Index = 1 To projCount
compoCount = VBInstance.VBProjects(Index).VBComponents.Count
For jIndex = 1 To compoCount
csFileName = VBInstance.VBProjects(Index).VBComponents(jIndex).name
componentType = VBInstance.VBProjects(Index).VBComponents(jIndex).Type
If componentType = VBIDE.vbext_ct_VBForm Or componentType = VBIDE.vbext_ct_UserControl Then '.frm or .ctl
VBInstance.VBProjects(Index).VBComponents(jIndex).Properties(propChange).Value = propvalue 'changing the property
VBInstance.VBProjects(Index).VBComponents(jIndex).SaveAs csFileName 'Saving the file
End If
Next jIndex
Next Index
End Sub
Whenever I give the Properties name as Font, I get the error
Runtime error '425' Invalid Object use
I have tried PropertyBag.WriteProperty from http://visualbasic.freetutes.com/learn-vb6-advanced/lesson13/p20.html but it does not serve my purpose.
Is there any way out to set the Font property of a control or form?
When I open the ctl or form in notepad, I cannot find the Font property in it so I cannot use text replacement here.
Can anyone help?
Updated Code :
Private Sub Update_ButtonClick()
Dim fobject As New StdFont
fobject.Name = "Arial"
Set propvalue = fobject
For Index = 1 To projCount
compoCount = VBInstance.VBProjects(Index).VBComponents.Count
For jIndex = 1 To compoCount
csFileName = VBInstance.VBProjects(Index).VBComponents(jIndex).Name
componentType = VBInstance.VBProjects(Index).VBComponents(jIndex).Type
If componentType = 5 Or componentType = 8 Then
VBInstance.VBProjects(Index).VBComponents(jIndex).Properties("Font").Value= propvalue
VBInstance.VBProjects(Index).VBComponents(jIndex).SaveAs csFileName
End If
Next jIndex
Next Index
End Sub
And the error that i got is
Run-time error '425':
Invalid object use

The Font property is an object, not an simple intrinsic value. You'll need to use Set with an appropriate StdFont object assigned to propvalue.
Alternatively, you can special case the font and just set the property's .Name property to the required font name.

Related

vba refer to control as variable syntax

I am creating controls with VBA and cannot set the font by referring to them as a control.
I name them and can modify the font if I refer to them by name Me.(control variable name).Font.
I need to know the proper Syntax to make that work.
I think I've tried every combination but none has been successful.
For CountRecords = 0 To rs.RecordCount - 1
tempLeft = 6
For countfields = 0 To rs.Fields.Count - 1
tempname = rs.Fields.Item(countfields).Name & CountRecords
frmtst.Controls.Add "forms.textbox.1", tempname
Set ctl = Me.frmtst(tempname)
Me.test.Font = 14 'set the font on a test textbox
Me.Controls(tempname).Value.Font = 14 '****Trouble line ********
ctl.Width = ((columnwidth(countfields) ^ 0.8) * 10) + 25
ctl.Height = 24
ctl.Left = tempLeft 'templeft + columnwidth(CountFields) + 18
tempLeft = tempLeft + ctl.Width + 3
ctl.Top = 20 * CountRecords + 3
ctl = rs.Fields.Item(countfields).Value
If rs.Fields.Item(countfields).Type = 6 Then
ctl = Format(ctl, "$#,##0.00")
end if
Next countfields
rs.MoveNext
Next CountRecords
How to reference controls properly
You can reference controls
1a) directly by Name and using IntelliSense (e.g. Me.Test),
1b) indirectly via the Controls collection or
2) implicitly via setting an object directly or indirectly (e.g. Set ctl = Me.Controls(tempname))
Note that the particle Me always refers to the current UserForm instance (not to its name) and can/should be used within the userform code module.
For instance you can refer to Me.Controls or a given item within the controls' collection, e.g. Me.Controls(tempname).
- It's bad use, however to refer to the default instance of a UserForm (e.g. frmtst) from that form's code behind.
Furthermore it's impossible to refer to both within the same statement like Me.frmtst(tempname).
Suggested reading for a deeper understanding: UserForm1.Show?
1a) Missing .Size property in test assignment to .Font
' Direct referencing a control of the current Userform instance - missing .Size property
Me.Test.Font.Size = 14 ' instead of: Me.test.Font = 14
1b) Bad insertion of .Value property before failing .Font property
' Indirect referencing a control of the current Userform instance - bad .Value prop, .Font prop without .Size
Me.Controls(tempname).Font.Size = 14 ' instead of: Me.Controls(tempname).Value.Font = 14
2) Object reference
If, however you prefer to set an object to the memory, the code line as shown in case [1b] is redundant and
you should decide to stick to the chosen method.
Dim ctl As MsForms.TextBox ' declare MSForms object (e.g. TextBox, or Object)
Set ctl = Me.Controls(tempname) ' instead of: Set ctl = Me.frmtst(tempname)
ctl.Font.Size = 14 ' instead of: .Font = 14
Further remarks
Always use Option Explicit to check the correct and complete declaration of all variables (would have been fine to include some in your code).
BTW did you actually calculate the control's width via an exponent, i.e. ^ 0.8) * 10) + 25?
Using Me in a form procedure is a replacement for the form name, which seems to be frmtst above. So Me.frmtst(tempname) is a double refer.
You can refer to the control tempname with Me.tempname. Set the font with Me.tempname.Font.Name = "Lucida Console" and set font size with Me.tempname.Font.Size = 10

How to resize a graphic object in the LINK field?

After a Paste special linking of a range of cells from Excel to Word (2013) the field looks like this:
{ LINK Excel.SheetMacroEnabled.12 D:\\20181228\\SC.xlsm Sheet1!R10C1:R10C20" \a \p }
If you click on the object with the right button, select "Format object" and then click on "?", the Format AutoShape reference article opens.
However, ActiveDocument.Shapes.SelectAll does not detect this object.
This code also does not work, although the error message says that this component is available for pictures and OLE objects:
With ActiveDocument.Shapes(1).PictureFormat
.ColorType = msoPictureGrayScale
.CropBottom = 18
End With
What is this object?
I cannot find it in Object model (Word).
How to access it through VBA?
I want to programmatically resize a group of such objects to 90% of the original.
Upd. #Cindy Meister suggested where to dig, thanks.
I wrote the code, it seems to work fine:
Sub ResizeImages()
Dim img As Long
With ActiveDocument
For img = 1 To .InlineShapes.Count
With .InlineShapes(img)
.ScaleHeight = 90
.ScaleWidth = 90
End With
Next img
End With
End Sub
A Link field must be an InlineShape - it can't be a Shape, not if you can display the field using Alt+F9. Since Shape objects have text wrap formatting any field codes associated with them (usually none) aren't accessible.
Therefore, any object that's displayed via a Link field should be available via the InlineShape object model.
For example, the following code loops the fields in the document and, if they're link fields with an Excel source and contain an InlineShape, the InlineShape's dimensions are scaled:
Dim fld as Word.Field
For Each fld In ActiveDocument.Fields
If fld.Type = wdFieldLink
If fld.Result.InlineShapes.Count > 1 And _
InStr(fld.OLEFormat.ClassType, "Excel") Then
Set ils = fld.Result.InlineShapes(1)
ils.ScaleWidth = 90
ils.ScaleHeight = 90
End If
End If
Next

VBA class module: get property from an object using another property

All,
I am setting-up a class module structure in VBA to add plans that have multiple milestones, but I'm quite new to it. I did the following:
A class module called 'Plan' that contains a 'name' property (string) and a 'Milestones' property (class Milestones).
This milestones class module is a collection of objects of a class module called 'Milestone'.
The 'Milestone' class has a 'name' property and a 'value' property.
So in my module I am now specifying the milestones for a specific plan:
Plan.Milestones.Add "MilestoneA", Cells(i, 5)
Plan.Milestones.Add "MilestoneB", Cells(i, 7)
...
Until now everything is fine. Now for MilestoneC I would like to know the value of MilestoneA. How do I get the value for the Milestone with name 'MilestoneA'.
I know the below code would give me the answer, but I don't want to hardcode 'item(1)' (I want to use the name):
Plan.Milestones.Item(1).Value
In the clsMilestones class:
Private prvt_Milestones As New Collection
Property Get Item(Index As Variant) As clsMilestone
Set Item = prvt_Milestones(Index)
End Property
Sub Add(param_Name As String, param_Value As String)
Dim new_milestone As clsMilestone
Set new_milestone = New clsMilestone
new_milestone.Name = param_Name
new_milestone.Value = param_Value
prvt_Milestones.Add new_milestone
End Sub
Your Milestones class is a collection class. By convention, collection classes have an Item property that is the class' default member. You can't easily specify a class' default member in VBA, but it's not impossible.
Export the code file, open it in Notepad. Locate your Public Property Get Item member and add a VB_UserMemId attribute - while you're there you can add a VB_Description attribute, too:
Public Property Get Item(ByVal Index As Variant) As Milestone
Attribute Item.VB_UserMemId = 0
Attribute Item.VB_Description = "Gets the item at the specified index, or with the specified name."
Set Item = prvt_Milestones(Index)
End Property
The UserMemId = 0 is what makes the property the class' default member - note that only one member in the class can have that value.
Don't save and close just yet.
You'll want to make your collection class work with a For Each loop too, and for that to work you'll need a NewEnum property that returns an IUnknown, with a number of attributes and flags:
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through the collection."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = prvt_Milestones.[_NewEnum]
End Property
Note that your internal encapsulated Collection has a hidden member with a name that begins with an underscore - that's illegal in VBA, so to invoke it you need to surround it with square brackets.
Now this code is legal:
Dim ms As Milestone
For Each ms In Plan.Milestones
Debug.Print ms.Name, ms.Value ', ms.DateDue, ...
Next
Save the file, close it, and re-import it into your project.
Since you're populating the collection using a string key (at least that's what your Add method seems to be doing), then the client code can use either the index or the key to retrieve an item.
And now that Item is the class' default member, this is now legal:
Set milestoneA = Plan.Milestones("Milestone A").Value
Note that your Add method needs to specify a value for the Key argument when adding to the internal collection - if you want the items keyed by Name, use the Name as a key:
Public Sub Add(ByVal Name As String, ByVal Value As Variant)
Dim new_milestone As Milestone
Set new_milestone = New Milestone
new_milestone.Name = Name
new_milestone.Value = Value
prvt_Milestones.Add new_milestone, Name
End Sub
Use a dictionary of Milestone classes in the plan class and set the key to be the "Milestone_x" and the item to be a milestone class
Then you can say Plan.Milestones("Milestone99")
Add a property to the Milestones class that returns the milestone based on the name:
Property Get SelectByName(strMilestoneName as string) as clsMilestone
Dim vIndex
'Add code here to find the index of the milestone in question
vIndex = ????????
Set SelectByName = prvt_Milestones(Index)
End Property
OR
Edit the Item Property to Allow selection by either Index or Name:
Property Get Item(Index As Variant) As clsMilestone
If isNumeric(Index) then
Set Item = prvt_Milestones(Index)
Else
'Find Item based on Name
Dim vIndex
vIndex = ?????
Set Item = prvt_Milestones(vIndex)
End If
End Property

VBA: Can a set of "constants" be configured at runtime?

When writing macros for processing spreadsheets, I like to set constants at the top of the module, corrosponding to the various column numbers I'll have to use. I recently had a case where I would need to perform the exact same task on two slightly different file layouts. My solution was to turn the constants into variables, and call a configuration sub to set them depending on the file to be processed. The only thing I don't like about that solution is that what was constant, and protected against careless user (or developer(!)) tweaks to the code, is now in a variable.
Is there any way to make these configured values unchangeable in the main sub?
Original style:
Const iColUser = 1
Const iColColor = 2
Const iColPet = 3
Sub Main()
iColUser = 3 '<--This line will prevent sub from running.
New style:
Dim iColUser As Integer
Dim iColColor As Integer
Dim iColPet As Integer
Sub Config()
Select Case SpreadsheetType
Case a
iColUser = 1
iColColor = 2
iColPet = 3
Case b
iColUser = 3
iColColor = 2
iColPet = 1
End Select
End Sub
Sub Main()
iColUser = 2 '<--This line will run, and cause major damage.
Encapsulate them.
Add a class module, and make an abstraction over these. Abstract away the column numbering logic, exose Property Get accessors for your columns, and then another property with Get and Let accessors for the "mode", which determines the value returned by the properties.
Public Enum SpreadsheetType
A
B
End Enum
Private columnMode As SpreadsheetType
Public Property Get Mode() As SpreadsheetType
Mode = columnMode
End Property
Public Property Let Mode(ByVal value As SpreadsheetType)
columnMode = value
End Property
Public Property Get UserColumn() As Long
Select Case Mode
Case A
UserColumn = 1
Case B
UserColumn = 3
End Select
End Property
Public Property Get ColorColumn() As Long
Select Case Mode
Case A
ColorColumn = 2
Case B
ColorColumn = 2
End Select
End Property
Public Property Get PetColumn() As Long
Select Case Mode
Case A
PetColumn = 3
Case B
PetColumn = 1
End Select
End Property
Now to use it, you need an instance of the class. Assuming you called it Class1 (gosh don't do that!), using it would look like this:
Sub Test()
Dim sheetColumns As New Class1
sheetColumns.Mode = A
Debug.Print sheetColumns.UserColumn 'outputs 1
sheetColumns.Mode = B
Debug.Print sheetColumns.UserColumn 'outputs 3
End Sub
The code using this object can only ever read the values, not write to them - unless you implemented a Property Let accessor for the mutable values.

Get the index of a usercontrol in a control array at runtime

So I've got a usercontrol.
In the form, I have a control array of these usercontrols. Each instance of the control has an index set in the designer.
I want, at runtime, to get the index of a specific usercontrol (this is in the context of a For Each loop). However, "index" is not a member of the UserControl class. How do I make it so I can get the index at runtime?
Example of what I am trying to do:
for each UserControl in UserControls
OtherArray(UserControl.index) = UserControl.value
next UserControl
The Index property is a member of the Control and Extender objects, but NOT the user controls.
You can get the index by typing the variable correctly:
Dim UserControl As MyUserControlType
Dim UserControl2 As Control
For Each UserControl In UserControls
Set UserControl2 = UserControl
OtherArray(UserControl2.index) = UserControl.value
Next UserControl
You still need a variable of your user control type to access the Value property.
The former method no longer works.
As the user control can access its Index through its Extender object, you can add an additional property that the caller can use:
Public Property Get MyIndex() As Long
MyIndex = Extender.Index
End Property
And this to access it:
Dim MyUserControlInstance As MyUserControl
Dim OtherArray() As String
ReDim OtherArray(0 To 3)
For Each MyUserControlInstance In MyUserControlArray
OtherArray(MyUserControlInstance.MyIndex) = MyUserControlInstance.Value
Next MyUserControlInstance
Most controls in VB6 have a Tag property. (It's been a while, so I don't remember if User Controls have this property as well.)
If they do, you could set the Tag property to the same value as the array index, in the form designer.
If User Controls don't have a Tag property, you could loop through the array at program startup and set the Tag property of one of the controls inside each User Control. For example, pick some Label or TextBox control to hold the "Tag" property for the entire Uset Control.
Try using a for loop and access them by index:
For I = UserControls.LBound To UserControls.UBound
'Use I as the index here
Next
Note that if the array is not contiguous (Some indexes in the middle are not loaded) you will need to detect the error and skip to the next item.
I suggest a small improvement on the code above:
If the UserControl is not in an array, Extender.Index causes an error.
MyIndex returns -1 if the Usercontrol is not in an array.
Public Property Get MyIndex() As Long
On Error GoTo NotAnArrayNoIndexError
MyIndex = Extender.Index
On Error GoTo 0
Exit Property
NotAnArrayNoIndexError:
On Error GoTo 0
MyIndex = -1
End Property
What about the "name" Property. In the ControlsCollection every Control has a name.
dim i as long
dim found as boolean
for i = lBound(OtherArray) to uBound(OtherArray)
for each UserControl in UserControls
if OtherArray(i).name = UserControl.name then
found = true
exit for
end if
next UserControl
if found then exit for
next UserControl

Resources