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
Related
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.
I have connected a weighing scale to my PC via an RS-232 to USB converter cable. My goal was to create a command button in excel 2007 that would place the weight from the scale into the selected cell. I got it to work using the following code in a userform.
Private Sub XMCommCRC1_OnComm()
Static sInput As String
Dim sTerminator As String
Dim Buffer As Variant
' Branch according to the CommEvent property
Select Case XMCommCRC1.CommEvent
Case XMCOMM_EV_RECEIVE
Buffer = XMCommCRC1.InputData ' Use Input property for MSComm
sInput = sInput & Buffer
If Worksheets("Settings").Range("Terminator") = "CR/LF" Then
sTerminator = vbCrLf
Else
sTerminator = vbCr
End If
If Right$(sInput, Len(sTerminator)) = sTerminator Then
XMCommCRC1.PortOpen = False
sInput = Left$(sInput, Len(sInput) - Len(sTerminator))
Select Case Left$(sInput, 2)
Case "ST", "S "
ActiveCell.Value = CDbl(Mid$(sInput, 7, 8))
ActiveCell.Activate
Case "US", "SD"
MsgBox "The balance is unstable."
Case "OL", "SI"
MsgBox "The balance is showing an eror value."
End Select
sInput = ""
End If
End Select
End Sub
Public Sub RequestBalanceData()
With Worksheets("Settings")
' Configure and open the COM port
If Not XMCommCRC1.PortOpen Then
XMCommCRC1.RThreshold = 1
XMCommCRC1.RTSEnable = True
XMCommCRC1.CommPort = .Range("COM_Port")
XMCommCRC1.Settings = .Range("Baud_Rate") & "," & _
.Range("Parity") & "," & _
.Range("Data_Bits") & "," & _
.Range("Stop_Bits")
XMCommCRC1.PortOpen = True
End If
' Send balance's "SI" (Send Immediate) command
' to request weighing data immediately
If .Range("Terminator") = "CR/LF" Then
XMCommCRC1.Output = "R" & vbCrLf
Else
XMCommCRC1.Output = "R" & vbCr
End If
End With
End Sub
I then created a command button with the following code.
Private Sub CommandButton1_Click()
UserForm1.RequestBalanceData
End Sub
When I click on the command button the weight is placed in the selected cell. However, this does not consistently happen. Sometimes when I click the button nothing will be placed in the cell, and I will have to click it multiple times until the weight is placed in the cell. I would like to fix this, but I'm not sure where to start. Is it a problem with the code itself, or is it more likely a problem with the converter or the scale itself?
Any help is appreciated.
Here is the scale: https://www.optimascale.com/product-page/op-915-bench-scale
Here is the converter cable: https://www.amazon.com/gp/product/B06XJZHCV8/ref=ox_sc_act_title_3?smid=A33N7O64F8FSDL&psc=1
Here is the tutorial I used for the code: http://www.msc-lims.com/lims/diybalance.html
Here is the ActiveX control from the tutorial that I used: http://www.hardandsoftware.net/xmcomm.htm
EDIT: I have done what Wedge has suggested and placed a Mgsbox sInput after my first End If. I have been getting inconsistent results. I am wondering if I need to change my scales sending format. The scale is currently set to sending format 4.
Here is the scale manual (sending formats are on page 21-23: https://docs.wixstatic.com/ugd/78eff6_e629ae5fe7004c7189060cca4bc7c3de.pdf
2ND EDIT:
I have connected my serial port to putty. My scale is in continuos sending mode. In putty the scale is consistently sending the following: ST,GS+ 0.00lb. However, when i try to enter the weight value in a cell, the message box sometimes displays that part of the data sent (ST,GS+ 0.00lb) has got cut off, or has been sent multiple times with one button press. Does anyone know how I would fix this?
3RD EDIT: It seems to me that the continuous sending mode (mode 4) my scale is set to is sending data too fast and is causing my code to mess up. I would like to try to make this work with the command request mode (mode 3), but I can't figure out how to properly parse the data string and place it into a cell. The sending format for command request mode is :
If anybody could help me figure out how to get this working I would greatly appreciate it.
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 am copying the string values out of text boxes on a form and saving them in the settings. The way I am doing it here seems kind of long handed. Is there a way to reference the TextBox1.Text and the My.Settings.Value1 with a string. If so then I could just loop through and keep changing the strings to point at the different controls. See the way I am currently doing it.
My.Settings.F1LabelCol0Save = F1LabelCol0.Text
My.Settings.F1LabelCol1Save = F1LabelCol1.Text
My.Settings.F1LabelCol2Save = F1LabelCol2.Text
My.Settings.F1LabelCol3Save = F1LabelCol3.Text
My.Settings.F1LabelCol4Save = F1LabelCol4.Text
My.Settings.F1LabelCol5Save = F1LabelCol5.Text
My.Settings.F1LabelCol6Save = F1LabelCol6.Text
My.Settings.F1LabelCol7Save = F1LabelCol7.Text
My.Settings.F1LabelCol8Save = F1LabelCol8.Text
My.Settings.F1LabelCol9Save = F1LabelCol9.Text
You can access both settings and controls dynamically via My.Settings.Item() and Me.Controls.Item().
I present you with two options:
1) Use a For loop for a fixed number range:
For x = 0 To 9
My.Settings("F1LabelCol" & x & "Save") = Me.Controls("F1LabelCol" & x).Text
Next
Upside: Does not swallow exceptions (see next example).
Downside: You must change the upper bound (currently 9) when you add new settings/controls.
2) Use a While loop for a dynamic number range.
Dim x As Integer = 0
While True
Try
My.Settings("F1LabelCol" & x & "Save") = Me.Controls("F1LabelCol" & x).Text
Catch
Exit While 'If an exception is thrown we've most likely hit the setting/control limit.
End Try
End While
Upside: Dynamic number range, you do not need to change anything when adding new settings/controls.
Downside: Swallows exceptions, i.e. you won't know when an exception is thrown for another reason than when a setting/control does not exist.
If you want to load data dynamically as well just reverse the get/set operation:
Me.Controls("F1LabelCol" & x).Text = My.Settings("F1LabelCol" & x & "Save")
I did some more research and here is how to do it. Now obviously it needs to be a number of of them very similarly named to to be worth it.
For i = 0 To 39
My.Settings("F1LabelCol" & i.ToString & "Save") = Me.Controls("F1LabelCol" & i.ToString).Text
Next
The following code is part of a function that is being called for each file the program finds during it's search through a directory.
set searchname = objFSO.OpenTextFile(server.mappath(filename),1, true)
do until searchname.AtEndOfStream
lineData = lcase(searchname.ReadLine())
if instr(lineData,s)>0 then
instances = instances + 1
end if
Loop
This the part of my code I'm confused with. This code worked perfectly yesterday. I made a few edits but mostly with HTML and CSS. When I pulled this code out today to optimize it better, I just keep getting a permission denied error with this line.
set searchname = objFSO.OpenTextFile(server.mappath(filename),1, true)
The problem is that the folder the code scans through contains some files that have more than one word. So it's essential that I get the "filename" variable within double quotes. I've been looking everywhere for a solution and none of them have been helpful yet. Is this even possible or is there a workaround?
Any help would be much appreciated here.
EDIT: As requested here's the code that gets the filename. Although no idea how it pertains to my question.
Function filesearch(name)
ext = instr(name,".txt")
vdirectoryvalue = instr(name,"Files\")+6
idname = mid(name,vdirectoryvalue,ext)
vdirectory = len(idname) - 4
filename = left(idname,vdirectory)
instances = 0
set searchname = objFSO.OpenTextFile(server.mappath(idname), 1, true)
do until searchname.AtEndOfStream
lineData = lcase(searchname.ReadLine())
if instr(lineData,s)>0 then
instances = instances + 1
end if
Loop
End Function