Retrieving weights from scales to excel - vba

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.

Related

VBA Label Property is showing FALSE at the end of code

I am trying to update Label Caption property as a part of progress of code being executed to let user know what task is being performed. Everything works great until code is completed. In the end it is showing FALSE value instead of retailing all the message what was shown. How do I make sure it keeps all the message which was shown ? Forms!Main!Message.Caption = Forms!Main!Message.Caption is the one showing progress of message to the Label Control.
Here is sample code:
If strSource_System <> "" Then
'--Download AP Data
Forms!Main!.ctrlProgressBar.Value = Timer - startTime
Forms!Main!Message.Caption = Forms!Main!Message.Caption & vbCrLf & "Downloading AP Data for System " & strSource_System & ". Please be patient..."
SleepSec (1)
Forms!Main!.ctrlProgressBar.Value = Timer - startTime
Call Download_AP_Data(Source_CONNECTION, "SOURCE")
Forms!Main!.ctrlProgressBar.Value = Timer - startTime
'Reset Clock
startTime = Timer
Forms!Main!Message.Caption = Forms!Main!Message.Caption & vbCrLf & "AP Data Downloaded for System " & strSource_System & " Successfully."
SleepSec (1)
Forms!Main!.ctrlProgressBar.Value = Timer - startTime
End If
You are appending all messages to the same label. The label's text might exceed its maximum length at some point and produce an error. If you have an On Error Resume Next, you will not see this error.
I suggest using a ListBox instead. This allows you to add the messages as new items into the ListBox. The Row Source Type of the ListBox must be Value List.
A Label can hold a maximum of 2,048 characters. A ListBox in ValueList mode can hold up to 64K characters (i.e., 32 times more).
If this is not enough, bind the ListBox to a table and add up to 64 records (i.e., up to 64k messages).
But you could also limit the number of messages displayed and start deleting the first messages when exceeding this limit to get a rolling display.
messageListBox.AddItem "Downloading AP Data for System " & strSource_System & ". Please be patient..."
DoEvents
And if you automatically want to scroll to the last item added, you can do this
' Scroll to the last item
messageListBox.SetFocus 'Next line does not work otherwise.
messageListBox.ListIndex = messageListBox.ListCount - 1
' Unselect it
messageListBox.Selected(messageListBox.ListCount - 1) = False
It's easier to extract this code to another Sub
Private Sub DisplayMessage(ByVal message As String)
messageListBox.AddItem message
messageListBox.SetFocus
messageListBox.ListIndex = messageListBox.ListCount - 1
messageListBox.Selected(messageListBox.ListCount - 1) = False
DoEvents
End Sub
and then call it with
DisplayMessage "some message"
If you make this Sub public, then you can even place it in the Main form and then call it from the module with
Forms!Main.DisplayMessage "some message"
This has the advantage that this module does not have to know anything about a label or ListBox. The same could be done with a Sub ShowProgress.

How to read and write to controls or settings with Visual Basic

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

Creating error macro

I currently have a macro that will deliver a pop up in the event that a field is left blank. The problem that I have is, once you acknowledge the error, it goes away and lets you proceed without filling in the field. Does anyone know what I am missing in the macro? I won't post the entire script because it is very long but it currently looks like this...
If Range("L58") = "Sigma Network" And Range("M58") = "" Then MsgBox "Please enter cable length "
Can I create one script that will work for all of the others or does each need to have its own?
Very simply, something like:
If Range("L58") = "Sigma Network" And Range("M58") = "" Then
Range("M58").Value = InputBox("Please enter cable length ", "Input value!", 0)
End If
You would of course need additional logic to prevent the user from entering a 0-value or empty string, etc.,
If you're doing this on for example, 50 different pairs of cells, (say L58 to L107 and M58 to M107 for example) this is a basic loop structure that you could use:
Dim cl as Range
For Each cl in Range("L58:L107")
If cl.Value = "Sigma Network" and cl.Offset(0,1).Value = "" Then
cl.Offset(0,1).Value = GetValue("Please enter cable length ", "Input value!", 0)
End If
Next
The loop can be further refined (e.g., if "Sigma Network" isn't the only thing you're checking for, or if you need different message text for the input box based on some other conditions, etc.
This will require the custom GetValue function which invokes the InputBox prompt, and configured to prevent 0-value input from the user. Additional logic may be required to prevent other types of data entry.
Function GetValue(msg as String, _
Optional title as String = "", _
Optional default as Double = 0)
'Function that calls the InputBox method
Dim ret
Do Until ret <> 0
ret = InputBox(msg, title, default)
Loop
GetValue = ret
End Function

"IF" code is not working inside for each?

so im learning to use socket and thread things in the networking software. so far, the software (which is not created by me) is able to chat in multiple group, but i'm tasked to allow user to code whisper feature. However, im stuck in the coding area, which im sure will work if the "if" function work inside "for each" function, anyhow here is my code mainly
Private clientCollection As New Hashtable()
Private usernameCollection As New Hashtable()
clientCollection.Add(clientID, CData)
usernameCollection.Add(clientID, username)
oh and before i forgot, the code above and below is on the server form page
on the client side, i write the code:
writer.write("PMG" & vbnewline & txtReceiverUsername & Message)
then next is the checking part on the server reading the message:
ElseIf message.Substring(0, 3) = "PMG" Then
'filter the message, check who to send to
Dim newMessage As String = message.Substring(3)
Dim messagearray As String() = newMessage.Split(vbNewLine)
Dim receiver As String = messagearray(1)
'0 = "", 1 = receiver, 2 = message
as i write before, clientcollection contain (clientID , connection data*) and usernamecollection contain (clientID, username). In my case, i only have the username data, and i need to trace it until the connection data on clientcollection hash table.
'find realid from usernamecollection, then loop clientcollection
Dim clientKey As String = 0
For Each de As DictionaryEntry In usernameCollection
'''''
'this if part Is Not working
If de.Value Is receiver Then
clientKey = de.Key
End If
'''''
Next de
'match objKey with clientcollection key
For Each dec As DictionaryEntry In clientCollection
If dec.Key = clientKey Then
Dim clients As ClientData = dec.Value
If clients.structSocket.Connected Then
clients.structWriter.Write("PMG" & messagearray(2))
End If
End If
Next dec
End If
so, how do i know that the if part is the wrong one? simply i tried these code before the "next de" code
For Each client As ClientData In clientCollection.Values
If client.structSocket.Connected Then
client.structWriter.Write("PMG" & "receiver:" & messagearray(1))
client.structWriter.Write("PMG" & "loop username: " & de.Value)
client.structWriter.Write("PMG" & "loop key: " & de.Key)
client.structWriter.Write("PMG" & "receiver key:" & clientKey)
End If
Next
the code allow me to check the de.key and de.value. they were correct, however the only thing that did not work is the code inside the "if" area.
Can anyone suggest other code maybe beside "if de.key = receiver"? I've also tried using the if de.key.equal(receiver) and it did not work too

Open new instance of a form based on data in field of first form

I have a data entry form where the data clerk enters client ID among other things. Client ID's are unique to each client. I am currently trapping for duplicate ID's and allowing the clerk to go to the search form and seach for the duplicate ID to verify that it is indeed the same person and not an error inputting data. I would rather open a new instance of the data entry form based on the client ID inputted into the data entry form. I can open a new instance but am not sure how to make it display the client data based on the client ID.
There is no good way to do this except to just turn off the screen painting. Here's some code from one of my apps:
Dim frm As Form_frmInventory
Dim strRecordsource As String
Dim intType As Integer
DoCmd.Hourglass True
Application.Echo False
Set frm = New Form_frmInventory
frm!boxHeader.BackColor = 3276900 ' 5483007
frm!boxFooter.BackColor = 3276900 ' 5483007
strRecordsource = "SELECT qryInventoryForm.*, varZLStoNull(IIf([tblInventory].[InventoryClass] In ('BKS','FAC','MTH','MUS','REF','SSC'),[Creator] & [Dates] & OtherAuthors([OtherAuthors]))) AS BibCreator, CreatorDates([Birth],[Death],[OtherAuthors]) AS Dates, varZLStoNull(Trim(nz(UCase([tblBib_Authors].[LastName]) & IIf(Not IsNull([tblBib_Authors].[FirstName]),', ') & [tblBib_Authors].[FirstName],'Anon.'))) AS Creator, tblBib_Authors.CreatorCategories, Nz([CreatorSort],[LastName] & [FirstName]) AS NameSort FROM qryInventoryForm LEFT JOIN tblBib_Authors ON qryInventoryForm.CreatorID = tblBib_Authors.CreatorID WHERE ([quantity]>0 Like getSold()) AND (qryInventoryForm.InventoryID=" & lngInventoryID & ") ORDER BY Nz([CreatorSort],[LastName] & [FirstName]), InventoryClass, ShortTitle;"
frm.RecordSource = strRecordsource
' need to change the caption and disable certain things
frm.Caption = frm.Caption & " -- " & frm!InventoryClass & "-" & Nz(frm!InventoryNo, Format(frm!InventoryID, "00000"))
frm!fldShortTitle.SetFocus
frm!cmbClassFind.Enabled = False
frm!cmbCreatorFind.Enabled = False
frm!cmbInventoryNumber.Enabled = False
[etc.]
frm.Visible = True
GoTo exitRoutine
CloseForm:
Call CloseForm(Me, True)
exitRoutine:
Application.Echo True
DoCmd.Hourglass False
Exit Sub
The CloseForm() sub is pretty important, as you have to keep track of multiple instances of the form and close the right one. I got the code from the ADH97 and adapted it from there (just the basics).
It would appear from that code (I've forgotten the details) that a form instantiated with Set frm = New Form_frmInventory is not visible until you explicitly reveal it. That's a plus, as it should mean that you don't have to turn off the screen (i.e., Application.Echo False), but I'm pretty sure that I recall needing it anyway to make things appear smoothly. My memory is that the form would appear with its normal colors and then the background colors would change visibly as the code ran. This means it was visible, so I'm not sure why it's necessary to then explicitly set the form visible.
Anyway, that should get you started, I think!