I am writing this code that initiates an object when a button is clicked.
Public Sub cmdMA_Click()
Set this_renewal = CreateRenewal(this_renewal, cMA)
Call BranchLabelVisibility(True)
Me.Controls("lblBranchToAdd" & 1).Caption = this_renewal.Abb
Call DateLabelVisibility(True)
Me.Controls("lblYearToAdd" & 1).Caption = this_renewal.Year
Me.Controls("lblMonthToAdd" & 1).Caption = this_renewal.Month
Call TestMonth(1)
End Sub
However, certain buttons will need to run the same exact code on 2 objects like this:
Public Sub cmdAB_Click()
Set this_renewal = CreateRenewal(this_renewal, cAB)
Dim i As Integer: For i = 1 To 2
Call BranchLabelVisibility(True)
Me.Controls("lblBranchToAdd" & i).Caption = this_renewal.Abb
Call DateLabelVisibility(True)
Me.Controls("lblYearToAdd" & i).Caption = this_renewal.Year
Me.Controls("lblMonthToAdd" & i).Caption = this_renewal.Month
Call TestMonth(i)
Next i
End Sub
I figured out how to do this with the controls, but I cannot figure out how to do this with my user defined class Renewal. I want to change it to something like this:
set Renewal("this_renewal" & i) = CreateRenewal(Renewal("this_renewal" & i))
Is there a way to do something like this? And then later I can call the object similarly.
I would use an array of Renewal objects.
Dim Renewals(1) As Renewal
Set Renewals(0) = CreateRenewal(this_renewal, cMA)
Set Renewals(1) = CreateRenewal(this_renewal, cAB)
' Usage:
Me.Controls("lblBranchToAdd" & i).Caption = Renewals(i - 1).Abb
NOTE: There is a lot of code missing in your example. Not sure where this_renewal comes from. My example is not going to "just work" but it shows you the pattern you would use.
Related
I have a big table in ms-word that contains 85 contentcontrols (combo boxes). I want to change the content using a vba loop (see below). It takes longer than one minute for it to complete...
Are there other options?
Private Sub Btn_Clear1_Click()
Dim a
Dim c As ContentControl
a = FindTable(ActiveDocument.Name, "myTableName")(1) 'returns an array(Long) with number of table found
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
End Sub
Thanks in advance for any hint!
Here, turning off screenupdating reduces the time from about 6 seconds to less than 1 second. e.g.
On Error Goto turnscreenon
Application.Screenupdating = False
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
turnscreenon:
Application.Screenupdating = True
That may only work on the Windows version of Word.
If you know exactly how many combo boxes there are going to be, you could consider creating a custom xml part containing an array of XML Elements to contain the values. Map each content control to one of those elements. Then instead of writing the values to the content control ranges, write them to the XML Part and let Word do the work. That works almost instantaneously here.
e.g. in a simple scenario where you just have those 85 content controls in the table, you could set up the Custom XML Part like this (I leave you to write any code that you need to delete old versions). You should only need to run this once.
Sub createCxpAndLink()
' You should choose your own Uri
Const myNamespaceUri As String = "mycbcs"
Dim a
Dim i As Long
Dim s As String
Dim cxp As Office.CustomXMLPart
With ActiveDocument
a = FindTable(.Name, "myTableName")(1)
s = ""
s = s & "<?xml version='1.0' encoding='UTF-8'?>" & vbCrLf
s = s & "<cbcs xmlns='" & myNamespaceUri & "'>" & vbCrLf
For i = 1 To .Tables(a).Range.ContentControls.Count
s = s & " <cbc/>" & vbCrLf
Next
s = s & "</cbcs>"
Set cxp = .CustomXMLParts.Add(s)
With .Tables(a).Range.ContentControls
For i = 1 To .Count
.Item(i).XMLMapping.SetMapping "/x:cbcs[1]/x:cbc[" & Trim(CStr(i)) & "]", "xmlns:x='" & myNamespaceUri & "'", cxp
Next
End With
Set cxp = Nothing
End With
End Sub
Then to update the contents you need something like this
Sub testsetxml()
Const myNamespaceUri As String = "mycbcs"
Dim i As Long
'our start time...
Debug.Print Now
With ActiveDocument.CustomXMLParts.SelectByNamespace(myNamespaceUri)(1)
For i = 1 To 85
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text "
' or if you want to put different texts in different controls, you can test using e.g.
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text " & Cstr(i)
Next
End With
'our end time...
Debug.Print Now
End Sub
(NB you cannot do it by mapping all the controls to a single XML element because then all the dropdowns will all be updated to the same value whenever you change the value of one of them.)
Apologies for any typos - I've changed the code to be more in line with what you have already and have not tested the changes.
I need to iterate through a list of forms to see if they are open and then do something with them if they are. The following works:
Public Sub isloadedtester()
Dim iForm As Variant
For Each iForm In CurrentProject.AllForms
Debug.Print iForm.name & ": " & CurrentProject.AllForms(iForm.name).IsLoaded
Next
End Sub
but it loops through all forms. So I thought the following should work to loop through only the forms I care about:
Public Sub isloadedtester2()
Dim iForm As Variant
Dim list
list = Array(Form_some, Form_another)
For Each iForm In list
Debug.Print iForm.name
Debug.Print ".isloaded: " & CurrentProject.AllForms(iForm.name).IsLoaded
Debug.Print "direct: " & SysCmd(acSysCmdGetObjectState, acForm, iForm.name)
Debug.Print "by fn: " & IsLoaded(iForm.name)
Next
End Sub
Public Function IsLoaded(FormName As String, Optional aType As AcObjectType = acForm)
IsLoaded = (SysCmd(acSysCmdGetObjectState, aType, FormName) <> 0)
End Function
However, the second version always sees forms as loaded, no matter which of several ways to read loaded state I use:
.isloaded: True
direct: 1
by fn: True
It's almost like assigning a form to an array makes VBA load the form.
Should I use something other than an array for this? I realize I could do this as an array of names that I also loop through to see if one fits, but that seems awkward, so I first wanted to see if I am just doing something slightly different than it needs to be.
If you only want open forms, then use the Forms collection. It includes only open forms
Dim intFrm As Integer
If Forms.Count > 0 Then
For intFrm = 0 To Forms.Count - 1
'Debug.Print Forms(intFrm).NAME
If Forms(intFrm).Name IsInYourList Then
DoSomething
End IF
Next intFrm
End If
If you have a list of form names, you can do it the "old-fashioned" way with SysCmd
Public Function IsLoaded(FName As String, Optional aType As AcObjectType = acForm)
IsLoaded = (SysCmd(acSysCmdGetObjectState, aType, FName) <> 0)
End Function
and
For Each iForm In list
Debug.Print iForm.Name & ": " & IsLoaded(iForm.Name)
Next
I need to create the code for CommandButton that will be created during run-time. This command button is dynamic because it based on the user data.
User_From code
Private Sub UserForm_Activate()
Dim ctlTXT As Control
For RevNo = 1 To RevCounter
Set ctlTXT = Me.Controls.Add("Forms.CommandButton.1")
ctlTXT.name = RevNo
ctlTXT.Caption = Sheet4.Range("D" & RevNo + 4).value
ctlTXT.Left = 18
ctlTXT.Height = 18: ctlTXT.Width = 72
ctlTXT.Top = 15 + ((RevNo - 1) * 25)
Next
Me.Height = (RevNo * 17) + 50
ReDim Preserve cmdArray(1 To RevNo)
Set cmdArray(RevNo).CmdEvents = ctlTXT
Set ctlTXT = Nothing
End Sub
Class module Code
Private Sub CmdEvents_Click()
Dim i As Integer
i = CmdEvents.name
RevisionFormPrevious.LblResponsible.Caption = Sheet4.Range("C" & i +4).value
RevisionFormPrevious.LblEdition.Caption = Sheet4.Range("D" & i + 4).value
RevisionFormPrevious.LblTelNo.Caption = Sheet4.Range("E" & i + 4).value
RevisionFormPrevious.LblFeatures.Caption = Sheet4.Range("D" & i + 4).value
RevisionFormPrevious.Features.value = Sheet4.Range("F" & i + 4).value
Load RevisionFormPrevious
RevisionFormPrevious.Show
End Sub
The problem is, if there are more than one button created, the code only works for the last button created. When the first and second button clicked, nothing happened.
Each CommandButton requires its own event procedure which includes its name. In order to create this procedure you need access to the VBA-Project which is highly discouraged because any hacker could take control of your computer through that door. Therefore you have two ways to handle the problem.
Create as many CommandButtons as you might possibly need, each one with its own event procedure. Hide the buttons you don't immediately need and unhide and reposition them where your code now creates them.
Create only one button with only one event procedure but assign different values to its Caption or, possibly, Tag properties. Then program your event procedure to do different things depending upon what the Caption or Tag is when the button is clicked.
I have a workbook with a very large amount of named ranges (well over 200). I really need a way to work quickly and easily with all of the named ranges so I can then work with / populate them using VBA.
My solution up until now has been to have code inside a bunch of get properties in my public NamedRanges module, to set the property equal to the named range, like so:
Public Property Get LotNumber49() As range
Set LotNumber49 = Common.GetRange(Strings.LotNumber49)
End Property
Where Strings.LotNumber49 is a property which contains the name of the named range as recorded in the workbook, and Common.GetRange is a method that returns a new instance of the desired range object.
While this solution works well (I can now access an instance of that named range by calling NamedRanges.LotNumber49) It is definitely time consuming and tedious to type up the property in the Strings class and another property in the NamedRanges class.
Is there a better way to accomplish this quick referencing of named ranges that anyone can think of? Perhaps iterating over the collection returned by the Workbook.Names property?
Thank you all, I have this workbook to work on as well as four others, which means a whole lot of named ranges!
Get Named Range by String
Why not a simple procedure like so:
Function GetNR(namedRange as String) as Range
Set GetNR = ActiveWorkbook.Names(namedRange).RefersToRange
End Function
Then simply get the named range like so:
Sub Example()
Debug.Print GetNR("NAME").Value
End Sub
Named Range Suggestion in VBA Project
Alternatively if you want the names to popup in your VBA project you need to redefine the Constants in the Strings class. Try this procedure:
Sub GetAllNames()
Dim res As String, n As Name
For Each n In ActiveWorkbook.Names
If InStr(n.Name, "!") = 0 Then res = res & "Const " & n.Name & "=""" & n.Name & """" & vbNewLine
Next n
Dim fFile As Long
fFile = FreeFile
Open "out.txt" For Output As #fFile
Print #fFile, res
Close #fFile
End Sub
You need to repeat this occasionally when modifying the named ranges:
Run the GetAllNames procedure
Open the out.txt file
Copy the outputs to your Strings class or whatever
Now to get a named range use your Common.GetRange method along with your Strings name or simply use the approach above to generate also the Getter code like so:
Sub GetAllGetters()
Dim res As String, n As Name
For Each n In ActiveWorkbook.Names
If InStr(n.Name, "!") = 0 Then res = res & "Public Property Get " & n.Name & "() As range" & vbNewLine & "Set " & n.Name & " = Common.GetRange(Strings." & n.Name & ")" & vbNewLine & "End Property"
Next n
Dim fFile As Long
fFile = FreeFile
Open "outGetters.txt" For Output As #fFile
Print #fFile, res
Close #fFile
End Sub
I am trying to add a button to my worksheet during run-time. This button should just display different worksheet that is also created on during run-time. I added button like this:
Dim btnShowTable
Set btnShowTable = ActiveSheet.Buttons.Add(rowRange.Left + 10, rowRange.Top + 10, rowRange.Width - 20, rowRange.Height - 20)
btnShowTable.Caption = "Show table data"
btnShowTable.OnAction = AddClickHandler_ShowSheet("ClickModule", "TableView", tableSheet)
Function AddClickHandler_ShowSheet(ByVal moduleName As String, ByVal btnName As String, ws As Worksheet)
Dim methodName As String
methodName = btnName & "_" & AddClickHandler_GetId() & "_Click"
Dim LineNum As Long
Dim VBCodeMod As CodeModule
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
With VBCodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, _
"Sub " & methodName & "()" & Chr(13) & _
" " & ws.CodeName & ".Select" & Chr(13) & _
"End Sub"
End With
AddClickHandler_ShowSheet = moduleName & "." & methodName
End Function
Function that creates the button is in one module while AddClickHandler_ShowSheet is in another.
The idea is that I would have separate module that would contain all these click handlers so that I could easily delete all of them.
This works ok. The handlers are created and buttons work as expected. The issue that I have is that, when this InsertLines method is called, all of my module variables in a module that contains the function for button creation are lost.
I have 4 module variables
Dim xmldoc As New MSXML2.DOMDocument
Dim xmlDataMap() As DataNode
Dim xmlDataMapLast As Integer
Dim xmlTables As Collection
after a call to InsertLines all of them became empty except for xmlDataMapLast which contains correct value of 14.
If I try to debug this method when I step over InserLines call I get an error "Can't enter break mode at this time." and I can't debug anything until my function ends. If I comment out the call to AddClickHandler_ShowSheet my variables remain intact, so it must be something related to that call.
Am I trying to achieve the impossible or am I just doing it the wrong way?
It's no surprise the module is reset.
In fact, I would expect value types to reset, too. It's a bit of surprise
they survive.
Why would you need to store variables in the module you use for code generation?
Store them in a separate module and only use this module for code generation.
Having that said, why would you dynamically add code in the first place?
OnAction supports parameters:
Sub asdff()
Worksheets(1).Buttons(1).OnAction = "'Module1.ParametrizedHandler 5, ""Hi there""'"
End Sub
Public Sub ParametrizedHandler(ByVal foo As Long, ByVal bar As String)
MsgBox foo, vbInformation, bar
End Sub
Note the absence of parentheses in the call string, and the single quotes around it.