Sub initialize()
For boxNum = 1 To 10
vaultValuesForm.Controls("h" & boxNum).Value = ""
vaultValuesForm.Controls("d" & boxNum).Value = ""
Next boxNum
vaultValuesForm.Show
End Sub
Sub button_Populate_Click()
Dim array_h(9) As String, array_d(9) As String
For boxNum = 0 To 9
array_h(boxNum) = vaultValuesForm.Controls("h" & (boxNum + 1)).Value
array_d(boxNum) = vaultValuesForm.Controls("d" & (boxNum + 1)).Value
Next boxNum
Call populateTable(array_h(), array_d())
End Sub
Sub populateTable(array_0() As String, array_1() As String)
For x = 1 To 4
ThisDocument.Bookmarks("bd" & x).Range.Text = array_0(0)
Next x
End Sub
I have tested the functionality of this code at various points, and it works flawlessly right up until this line:
ThisDocument.Bookmarks("bd" & x).Range.Text = array_0(0)
Specifically, until it reaches = array_0(0). In its current state, reaching this point in the Sub results in "Run-time error '5941': The requested member of the collection does not exist." Same deal when I originally tried using = array_0(x) (which is ultimately what I'm trying to accomplish). However, if replaced with something direct such as = "AA", it works. How do I phrase this bit properly to set the bookmark values to those within the array?
Note: In case you're wondering, the arrays are being referenced and passed properly; I tested this by changing the loop to comments and using MsgBox() with various array elements.
The answer from comments. The issue I wasn't aware of was that the bookmarks were being deleted after running the module, so it wouldn't work again unless the bookmarks were created again.
Are you sure the bookmarks bd1...bd4 are still there in the document? Because a bookmark's range.text deletes the bookmark, so if you want to be able to repeat the bookmark text assignments you have to recreate the bookmarks after assigning the texts. FWIW I ran your code and it was fine when bd1..bd2 etc. existed but threw 5941 the next time. (This is quite a common problem!) – slightly snarky Sep 3 at 8:37
So, for the official answer to my question, the way I had done it initially is how; it just couldn't be repeated.
Related
This question already exists:
VBA Function not storing variable
Closed 5 years ago.
I am reposting this question, because I haven't gotten an answer and I still can't figure out what I'm doing wrong. My latest efforts to resolve the problem on my own are detailed below the code.
Original post: VBA Function not storing variable
I have included the code of my function. I mostly scrapped this together from things I found online, because I am very much an amateur coder. I am trying to take the trendline of a graph and use it for a mathematical calculation. When I step through this code, it works great. However, when I call the function from another sub, it gives me an error. Error 9: Subscript out of range. When I debug, it shows me the line a = spl(0). The real problem is that the variable "s" remains empty. Why?
Function TrendLineLog() As Double
Dim ch As Chart
Dim t As Trendline
Dim s As String
Dim Value As Double
' Get the trend line object
Set ch = ActiveSheet.ChartObjects(1).Chart
Set t = ch.SeriesCollection(1).Trendlines(1)
' make sure equation is displayed
t.DisplayRSquared = False
t.DisplayEquation = True
' set number format to ensure accuracy
t.DataLabel.NumberFormat = "0.000000E+00"
' get the equation
s = t.DataLabel.Text '<--------- ACTUAL PROBLEM HERE
' massage the equation string into form that will evaluate
s = Replace(s, "y = ", "")
s = Replace(s, "ln", " *LOG")
s = Replace(s, " +", "")
s = Replace(s, " - ", " -")
spl = Split(s, " ")
a = spl(0) '<----------- DEBUG SAYS HERE
b = spl(1)
c = spl(2)
y = 0.5
..... Math stuff
End Function
I have tried adding the creation of the chart to the function to avoid an error with "Active Sheet". I also tried pasting this code into my sub instead of calling a separate function. Still nothing. When I debug and highlight the t.DataLabel.Text, it shows me the correct value, but for some reason s is not saving that value. In the Locals window, t has value, but s is blank (" ").
Yes, of course you will get an error on the line you pointed out. You are calling spl(0) as though it is its own function, though you did not define spl() as a sub (function) anywhere in this code. Or, alternatively (more likely) you are calling it as an array, which also throws up some flags.
Make sure you are defining spl in your code. You never do this. Add line:
Dim spl(1 to 3) As String
Then you should find that spl(1), spl(2), and spl(3) are what you desire.
I've got the following code:
Private Sub cboA_change()
'Something to determine number of controls there should be, variable gC
'Something to determine number of controls there are, variable nC
'The first time the code runs, the following code runs:
For i = nC to gC
frmA.Frame1.Controls.Add("txtGroup" & i)
Next
'The second time the code runs, the following is executed:
For i = 7 To nC
Me.Frame1.Controls("txtGroup" & i).Remove 'ERROR HERE
Next
For i = nC to gC
frmA.Frame1.Controls.Add("txtGroup" & i)
Next
End Sub
Something like this, the code is way bigger and I tried to clear it up so if the structure doesn't seem right, that doesn't matter really.
I debugged the Add statement and I know there is a control added to the userform, called txtGroup7. However, when I later try to remove this control, I get Run-time Error 438: Object Doesn't Support This Property or Method. I tried changing the code to:
Me.Frame1.Controls.Remove ("txtGroup" & i)
But this didn't work either.
Can anybody point me in the right direction?
Edit:
I know the help says the following:
"This method deletes any control that was added at run time. However,
attempting to delete a control that was added at design time will
result in an error."
But since the control is added in run-time (dynamically, with VBA code) this shouldn't be a problem, right?
Edit 2:
I don't get why this works, but it seems to work:
q=0
While q < Me.Frame1.Controls.Count
If Me.Frame1.Controls(q).Name = "txtGroup7" Then
Me.Frame1.Controls.Remove q
Else
q = q + 1
End If
Wend
You must have something else wrong in your code, because Removeshould be working. Tried :
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = True Then
Me.Frame1.Controls.Add "Forms.TextBox.1", "Text1", True
Else
Me.Frame1.Controls.Remove "Text1"
End If
End Sub
on a UserForm with a ToggleButton and a Frame and it correctly add and remove the TextBox when pressed.
I have a form that keeps track of assigned patient equipment. I have it set so that any changes made to text fields on the form automatically move down to the "comments" section of the form (this is done so that any changes made are documented in case the user forgets to manually document changes). I have a sub that I wrote that accomplishes this that I am currently calling for every single text field. This works but is messy.
Is there a way to apply the sub to all the fields in one procedure without calling it for every individual field? Code is below, please let me know if I can clarify anything.
Private Sub pPEMoveValue(sField)
'Moves the old field value down to the comments section automatically
Dim sOrigValue As String
Dim sCommentValue As String
sOrigValue = sField
sCommentValue = Nz(mPEComments, "")
Me.mPEComments = sCommentValue & vbNewLine & sOrigValue
End Sub
Private Sub sPEBatCharger_Dirty(Cancel As Integer)
pPEMoveValue (Nz(Me.sPEBatCharger.OldValue, ""))
End Sub
This is the solution I came up with to do what you are looking to do. I took advantage of the MS Access Tag system. You can add tags to your controls so you can sort of "Group" them.
First put the form in design view and adjust the tag for all of the fields you want to record to say "Notes".
Then in the Form's BeforeUpdate even you would add this:
Private Sub Form_BeforeUpdate(Cancel As Integer)
Call FindControlsForComments(Me.Form)
End Sub
Then you would use this function to find any fields that have the "Notes" tag and run it through the function you created:
Public Function FindControlsForComments(frm As Form)
Dim ctrl As Access.Control
For Each ctrl In frm
'If the control is tagged for notes
If ctrl.Tag = "Notes" Then
'If the old value is different than the current value
If Nz(ctrl.OldValue, "") <> Nz(ctrl.Value, "") Then
'Add to comment
Call pPEMoveValue(Nz(ctrl.Value, ""))
End If
End If
Next ctrl
End Function
You may have to adjusted this slightly to work with your system but this has worked well for me.
So I have a work around to my problem, but I don't really understand the problem, and my work-around is crude. I have a document level customization that can insert sheets from other documents not included in the customized document:
Private Sub LabReportTemplateAdder()
Dim ReportTemplate As Excel.Workbook
CurrentRun = Marshal.GetActiveObject("Excel.Application")
ReportTemplate = CurrentRun.Workbooks.Open("C:\Reports\Templates\" & LabReportListBox.SelectedItem())
ReportTemplate.Worksheets(1).Move(Before:=Globals.ThisWorkbook.Sheets(5))
End Sub
This script actually works fine every time in the deployment. But when I try to modify the added template (ie add information from a database) the modifications (many different actions) all fail with a missing reference error:
"This document might not function as expected because the following control is missing: Sheet5. Data that relies on this control will not be automatically displayed or updated, and other custom functionality will not be available. Contact your administrator or the author of this document for further assistance."
An examples of the type of code that fails:
Private Sub AllMaterialsAdder(xxDataGridView As DataGridView, CostColumnID As Double, InsertColumnID As Double, CountColumnID As Double, DescriptionIndex As Integer, CostIndex As Integer)
CurrentSheet = Globals.ThisWorkbook.ActiveSheet
If CurrentSheet.Name = NameSet Then 'this is abbreviated test to check make sure only the sheets we need are added
MsgBox("The active sheet isn't a Lab Report. It's " & CurrentSheet.Name & ".")
Else
Dim ItemCount As Double
ItemCount = CurrentSheet.Cells(1, CountColumnID).value
For Each row As DataGridViewRow In xxDataGridView.SelectedRows
CurrentSheet.Cells((4 + ItemCount), InsertColumnID).value = xxDataGridView.Item(DescriptionIndex, row.Index).Value
CurrentSheet.Cells((4 + ItemCount), CostColumnID).value = xxDataGridView.Item(CostIndex, row.Index).Value
ItemCount = ItemCount + 1
Next
End If
End Sub
or
Private Sub MaterialSummaryUpdater()
CurrentSheet = Nothing
Globals.MaterialSummaryWorksheet.UsedRange(5, 26).Clear()
For Each Me.CurrentSheet In Globals.EOSWorkbook.Worksheets
If CurrentSheet.Name <> NameSet Then 'this is abbreviated test to check make sure only the sheets we need are added [excluding NameSet]
Dim CurrentCount1, CurrentCount2, CurrentCount3, MasterCount1, MasterCount2, MasterCount3 As Int32
CurrentCount1 = CurrentSheet.Cells(1, 28).Value
CurrentCount2 = CurrentSheet.Cells(1, 33).Value
CurrentCount3 = CurrentSheet.Cells(1, 39).Value
If CurrentCount1 > 0 Then
MasterCount1 = Globals.MaterialSummaryWorksheet.Cells(2, 3).Value
Globals.MaterialSummaryWorksheet.Range(Globals.MaterialSummaryWorksheet.Cells((5 + MasterCount1), 1), Globals.MaterialSummaryWorksheet.Cells((4 + MasterCount1 + CurrentCount1), 6)).Value = CurrentSheet.Range(CurrentSheet.Cells(4, 25), CurrentSheet.Cells((3 + CurrentCount1), 30)).Value
End If
If CurrentCount2 > 0 Then
MasterCount2 = Globals.MaterialSummaryWorksheet.Cells(2, 8).Value
Globals.MaterialSummaryWorksheet.Range(Globals.MaterialSummaryWorksheet.Cells((5 + MasterCount2), 7), Globals.MaterialSummaryWorksheet.Cells((4 + MasterCount2 + CurrentCount2), 10)).Value = CurrentSheet.Range(CurrentSheet.Cells(4, 31), CurrentSheet.Cells((3 + CurrentCount2), 35)).Value
End If
If CurrentCount3 > 0 Then
MasterCount3 = Globals.MaterialSummaryWorksheet.Cells(2, 13).Value
Globals.MaterialSummaryWorksheet.Range(Globals.MaterialSummaryWorksheet.Cells((5 + MasterCount3), 12), Globals.MaterialSummaryWorksheet.Cells((4 + MasterCount3 + CurrentCount3), 16)).Value = CurrentSheet.Range(CurrentSheet.Cells(4, 36), CurrentSheet.Cells((3 + CurrentCount3), 40)).Value
End If
End If
Next
End Sub
I should note that this doesn't happen on the computer I'm developing on, but only in deployment, which might make it related to this question or this one.
Though I feel like the problem is bit different for me. First, all of the machines I am trying to deploy this on do have VSTO Tools for Office installed. Secondly, if I run a script that calls one of the Named Sheets within the customized document, it works. Simply adding a worthless variable before I ever add in a sheet seems to fix the problem:
Dim currentcount As Int32 = Globals.HistologyLaborSummaryWorksheet.Cells(2, 11).value
But if I call that after a sheet has been added it doesn't matter it will fail. My simple work around was to add this to the LabReportTemplateAdder sub, but I still don't understand why it should fail, and why that would fix it. Clearly the sheets exist, but I don't know if it has something to do with modifying the sheet index or if the worksheets need to be registered somewhere similar to the ROT problem I ran into earlier.
I'm looking for a better solution if there is one, and an explanation as to what is really failing here.
Thanks.
EDIT:
I'm running into this now in more places, and again, the work around seems crude. Here is a full error:
Microsoft.VisualStudio.Tools.Applications.Runtime.ControlNotFoundException:
This document might not function as expected because the following control is missing:
Sheet5. Data that relies on this control will not be automatically displayed or updated,
and other custom functionality will not be available. Contact your administrator or the
author of this document for further assistance. --->
System.Runtime.InteropServices.COMException: Programmatic access to the Microsoft Office
Visual Basic for Applications project system could not be enabled. If Microsoft Office
Word or Microsoft Office Excel is running, it can prevent programmatic access from being
enabled. Exit Word or Excel before opening or creating your project.
at Microsoft.VisualStudio.Tools.Office.Runtime.Interop.IHostItemProvider.GetHostObject(String primaryType, String primaryCookie, IntPtr& hostObject)
at Microsoft.VisualStudio.Tools.Office.Runtime.DomainCreator.ExecuteCustomization.Microsoft.Office.Tools.IHostItemProvider.GetHostObject(Type primaryType, String primaryCookie)
at Microsoft.Office.Tools.Excel.WorksheetImpl.GetObjects()
--- End of inner exception stack trace ---
at Microsoft.Office.Tools.Excel.WorksheetImpl.GetObjects()
at Microsoft.Office.Tools.Excel.WorksheetImpl.GetPrimaryControl()
at Microsoft.Office.Tools.Excel.WorksheetImpl.get_Cells()
at Microsoft.Office.Tools.Excel.WorksheetBase.get_Cells()
This looks relevant based on the fact that you are inserting sheets.
I have the following VBA code
Private Sub CreateQuery_Click()
Dim doc As Document
Dim i As Integer
Set doc = ActiveDocument
i = doc.Paragraphs.Count
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
For j = 0 To 1000
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
With doc.Paragraphs(i)
.Range.Font.Italic = True
.Range.ListFormat.ApplyBulletDefault
.Indent
.Indent
.TabStops.Add Position:=CentimetersToPoints(3.14)
.TabStops.Add Position:=CentimetersToPoints(10)
.TabStops.Add Position:=CentimetersToPoints(11)
End With
For k = 0 To 10
With doc.Paragraphs(i)
.Range.InsertAfter "testState" & vbTab & CStr(doc.Paragraphs(i).Range.ListFormat.CountNumberedItems) & vbTab & CStr(doc.Paragraphs.Count)
.Range.InsertParagraphAfter
End With
i = i + 1
Next
i = doc.Paragraphs.Count
With doc.Paragraphs(i)
.Range.ListFormat.ApplyBulletDefault
.TabStops.ClearAll
.Outdent
.Outdent
End With
Next
i = doc.Paragraphs.Count
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
End Sub
Basically this code just prints n numbers of lines with the specific format.
Bullet list
Indented
and TabStops
(source: lans-msp.de)
The Code works perfectly for an arbitrary number of lines, but then at some point Word just stops applying the TabStops.
I know that if I wouldn't reset the format every 10 lines, the code would work seemingly forever (really?!?). But the every 10 line brake is a must.
The exact line number where everything breaks down is dependent on the amount of RAM. On my work computer with 1GB it only works until about line 800(as you can see). My computer at home with 4GB didn't show this behaviour. But I'm sure it would have shown it as well if I had it let run long enough, because in my production code(which is a bit more complex) my home computer shows the problem as well.
Is this some kind of memory leak or something? What did I do wrong? Is maybe, god-forbid, VBA itself the culprit here?
Try to apply the formatting using a defined style. See if that makes a difference.
You might try turning automatic pagination off while adding the lines, to see if that helps.
Application.Options.Pagination = False