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
Related
Copy this into Visual Studio, add a textbox and it'll run.
Const NET_FW_ACTION_ALLOW = 1
Dim fwPolicy2 = CreateObject("HNetCfg.FwPolicy2")
Dim RulesObject = fwPolicy2.Rules
For Each rule In RulesObject
If rule.action = NET_FW_ACTION_ALLOW Then
TextBox1.Text += rule.name & vbnewline
End If
Next
This is an example of what I get but I only need each app to be listed once, not two times. What am I doing wrong or why does it behave like this?
qBittorrent
qBittorrent
Chrome
Chrome
Visual Studio
Visual Studio
and so on...
It behaves like this because rule.Name is not a unique identifier for a firewall rule. The same rule name may be used for different protocols (TCP, UDP), profiles (domain, private, public), direction (in, out), etc. If you are only interested in rule.Name, add them to a set, then print that set, as follows.
Const NET_FW_ACTION_ALLOW = 1
Dim fwPolicy2 = CreateObject("HNetCfg.FwPolicy2")
Dim RulesObject = fwPolicy2.Rules
Dim names As New HashSet(Of String)
' Create set of unique names.
For Each rule In fwPolicy2.Rules
If rule.action = NET_FW_ACTION_ALLOW Then
names.Add(rule.name)
End If
Next
' Add names to TextBox.
For Each name As String In names
TextBox1.Text += name & vbNewLine
Next
For Each rule In RulesObject
If rule.action = NET_FW_ACTION_ALLOW AndAlso TextBox1.Text.Contains(rule.name.ToString) = False Then
TextBox1.Text += rule.name & vbnewline
End If
Next
The above is one way to do it. It simply checks whether it's already added to the textbox. Btw, I don't know offhand whether or not rule.name is already a string so I added .ToString; if it's already a string, you don't need to add that.
Also, most of us would recommend using Option Strict, and declaring your variables as a type. i.e. Dim myVar as String = "some string"
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.
Thanks in advance for the help. I have no idea what I'm doing wrong and it's becoming very frustrating. First, a little background...
Program: Revit MEP 2015
IDE: VS 2013 Ultimate
I have created a Shared Parameter file and added the parameters in that file to the Project Parameters. These parameters have been applied to Conduit Runs, Conduit Fittings, and Conduits.
I'm using VB.NET to populate the parameters with no issue. After the code runs, I can see the expected text applied in the elements property window. Here is the code used to populate the values:
Populate:
Dim p as Parameter = Nothing
Dim VarName as String = "Parameter Name"
Dim VarVal as String = "Parameter Value"
p = elem.LookupParameter(VarName) <-- elem is passed in to the function as an Element
If p IsNot Nothing Then
p.Set(VarVal)
End if
Here's where I run into the error. When I attempt to retrieve the value, I am able to get the parameter by the parameter's definition name, but the value is always blank. Here is the code used to retrieve...
Try
For Each e As Element In fec.OfCategory(BuiltInCategory.OST_ConduitRun)
sTemp = sTemp & "Name: " & P.Definition.Name & vbCrLf & "Value: " & P.AsString & vbCrLf & "Value As: " & P.AsValueString & vbCrLf & vbCrLf
sTemp2 = sTemp2 & "Name: " & GetParamInfo(P, doc)
Next
MessageBox.Show(sTemp)
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
The message box shows all of the parameter names correctly, and for the Revit parameters it gives me a value. The Shared parameters, however, only show the parameter names, the values are always blank. Is there another way that I'm supposed to be going about this? Oddly, I'm able to see the shared parameter values if I use a reference by user selection like so...
Dim uiDoc As UIDocument = app.ActiveUIDocument
Dim Sel As Selection = uiDoc.Selection
Dim pr As Reference = Nothing
Dim doc As Document = uiDoc.Document
Dim fec As New FilteredElementCollector(doc)
Dim filter As New ElementCategoryFilter(BuiltInCategory.OST_ConduitRun)
Dim sTemp As String = "", sTemp2 As String = ""
Dim elemcol As FilteredElementCollector = fec.OfCategory(BuiltInCategory.OST_ConduitRun)
Dim e As Element = Nothing, el As Element = Nothing
Dim P As Parameter
pr = Sel.PickObject(ObjectType.Element)
e = doc.GetElement(pr)
For Each P in e.Paramters
sTemp = sTemp & "Name: " & P.Definition.Name & vbCrLf & "Value: " & P.AsString & vbCrLf & "Value As: " & P.AsValueString & vbCrLf & vbCrLf
sTemp2 = sTemp2 & "Name: " & GetParamInfo(P, doc)
Next
MessageBox.Show(sTemp)
With the method above, when the user selects the object directly, I can see the values and the names of shared parameters. How are they different?
Is there some sort of binding that I should be looking at when the value is set to begin with? Thanks in advance for everyone's help.
Regards,
Glen
Holy Bejeesus... I figured it out, but I'm not sure why the methods are that different from each other... if anyone had any insight, that'd be great.
I wanted to post the answer here, just in case anyone else is fighting with the same thing, so... you can see the method I was using to try to read the parameters above. In the method being used now there are only a couple of things that are different... 1) An element set... 2) An active view Id was added as a parameter to the FilteredElementCollector... 3) A FilteredElementIterator was implemented.
As far as I can tell it's the iterator that's making it different... can anyone explain what it's doing differently?
Below is the method that actually works...
Public Sub Execute(app As UIApplication) Implements IExternalEventHandler.Execute
Dim prompt As String = ""
Dim uiDoc As UIDocument = app.ActiveUIDocument
Dim doc As Document = uiDoc.Document
Dim ElemSet As ElementSet = app.Application.Create.NewElementSet
Dim fec As New FilteredElementCollector(doc, doc.ActiveView.Id)
Dim fec_filter As New ElementCategoryFilter(BuiltInCategory.OST_Conduit)
fec.WhereElementIsNotElementType()
fec.WherePasses(fec_filter1)
Dim fec_i As FilteredElementIterator = fec.GetElementIterator
Dim e As Element = Nothing
fec_i.Reset()
Using trans As New Transaction(doc, "Reading Conduit")
trans.Start()
While (fec_i.MoveNext)
e = TryCast(fec_i.Current, Element)
ElemSet.Insert(e)
End While
Try
For Each ee As Element In ElemSet
GetElementParameterInformation(doc, ee)
Next
Catch ex As Exception
TaskDialog.Show("ERROR", ex.Message.ToString)
End Try
trans.Commit()
End Using
End Sub
At any rate, thanks for any help that was offered. I'm sure it won't be the last time that I post here.
Regards,
Runnin
I'm working on an app that writes to excel. The following piece f code is working properly ( it fills the requested cell) but generating a run time exception that I can't get rid of.
For i = 1 To 1000 Step 1
If Not (cPart.Range("A" & i).Value = Nothing) Then
If (cPart.Range("L" & i).Value = Nothing) Then
cPart.Range("L" & i).Interior.ColorIndex = 3
End If
i = i + 1
End If
Next
the exception is: COMException was unhandled :Exception from HRESULT: 0x800A01A8
any help?
That HRESULT means Object Required. So it seems like one or more of the objects you try to operate on don't exist but as the code is written at the moment, it's difficult to be sure which it is. An immediate concern though is that you're comparing values to Nothing, in VB.Net you're supposed to use Is Nothing to check for that. Also, you've already set up the For loop to go from 1 to 1000, with a step of 1 (which you don't need to include since it's the default) but you're then doing i = i + 1 which looks like a mistake?
So fixing that and splitting it up into it's parts it might give you a better idea to what's not working:
For i = 1 To 1000
Dim aRange As Object = cPart.Range("A" & i)
If aRange IsNot Nothing AndAlso aRange.Value IsNot Nothing Then
Dim lRange As Object = cPart.Range("L" & i)
If lRange IsNot Nothing AndAlso lRange.Value Is Nothing Then
Dim interior As Object = lRange.Interior
If interior IsNot Nothing Then
interior.ColorIndex = 3
End If
End If
End If
Next
I've declared the new objects as Object which might need to be changed to the correct data types (depending on your project settings).
Hopefully you should now be able to run through the code without error and you should also be able to step through the code and find that one of the new objects (aRange, lRange and interior) is Nothing at some point when it shouldn't be which will show you why it threw that error before.
Another advantage to splitting up the code like this is that you'll now be able to dispose of the Excel objects properly so that the Excel instance can shut down cleanly. See this Q&A for info: Excel.Range object not disposing so not Closing the Excel process
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!