I'm working on an AutoCAD VBA program that creates a drawing.
But i have a slight problem. If "Case 1" is True Then "Case 2" must be false. Here is my code :
Sub Pumps()
'Option for type of pump piping
ans = InputBox("1 = STD Piping" & vbCrLf & _
"2 = Omit Pump", "Pump Piping")
Select Case ans
Case "1":
: Set layerObj = ThisDrawing.Layers.Add("PUMP-PIPING STD -" & Size)
layerObj.LayerOn = True
Case "2":
: Set layerObj = ThisDrawing.Layers.Add("OMIT PUMP -" & Size)
layerObj.LayerOn = True
Case Else: MsgBox "Wrong Input Dude.", vbCritical, MSG: Exit Sub
End Select
End Sub
Please Assist
So I'm not sure what the end goal was, but hopefully this gets you started.
What I've done I've isolated the "decision making" to the switch block, and that sets the toggle variable which is needed for the "work" to be done later. (and I would consider moving that "work" of actually setting the layerObj out to another Sub
Sub Pumps()
Dim ans As String
'Option for type of pump piping
ans = InputBox("1 = STD Piping" & vbCrLf & _
"2 = Omit Pump", "Pump Piping")
Dim toggle As Boolean
Select Case ans
Case "1": toggle = True
Case "2": toggle = False
Case Else: MsgBox "Wrong Input Dude.", vbCritical, MSG: Exit Sub
End Select
Set layerObj = ThisDrawing.Layers.Add("PUMP-PIPING STD -" & Size)
layerObj.LayerOn = toggle
Set layerObj = ThisDrawing.Layers.Add("OMIT PUMP -" & Size)
layerObj.LayerOn = Not (toggle)
End Sub
Remove the : from your code all over. Every single one of them.
It makes plenty of problems, especially with Conditions. You really cannot follow what is happening.
In general, the : means that you want the next line to stay on the similar line. It is useful only when you want to assign values to a newly declared variable like this: Dim k as long: k = 5 and its idea is to save space.
Take a look at this topic, you would understand what I mean:
VBA - How the colon `:` works in VBA code with condition
Related
Renaud Bompuis pulled together some great code. I want to put in font changes (e.g. bold) on a field result within the Dialog.RichText format.
I'm trying to get the result of CaptureEmail to be bold. The box just makes CaptureEmail bold. The value doesn't show up. If I remove the <strong> from the code, the email shows up, but not bold.
Private Sub Other_Email_BeforeUpdate(Cancel As Integer)
' https://www.devhut.net/2016/08/18/validate-e-mail-addresses/
Dim ClickResult As VbMsgBoxResultEx
Dim CaptureEmail
Dim html
CaptureEmail = Me.Other_Email
If CaptureEmail = 0 Then
Exit Sub
ElseIf CaptureEmail > 0 Then
If ValidateEmail(Me.Other_Email) = False Then
ClickResult = Dialog.RichBox("The inputted e-mail " & _
<strong>[CaptureEmail]</strong> & _
" does not appear to be a valid Email_Address. " & "<p/>" & _
"Would you like to recheck it before adding it?", _
vbYesNo + vbCritical, "Invalid Entry", , , 0, False, False, False)
If (ClickResult = vbYes) Then
Cancel = True
ElseIf (ClickResult = vbNo) Then
Exit Sub
End If
ElseIf ValidateEmail(Me.Other_Email) = True Then
Exit Sub
End If
End If
End Sub
The main issue with your code is the concatenation of the first argument supplied to the RichBox method:
"The inputted e-mail " & <strong>[CaptureEmail]</strong> & " does not appear to be a valid Email_Address. " & "<p/>" & _
"Would you like to recheck it before adding it?"
Since <strong> & </strong> are literal strings, they should be included as part of the content of the strings that are surrounded by double-quotes, e.g.:
"The inputted e-mail <strong>" & CaptureEmail & "</strong> does not appear to be a valid Email_Address. "
You also have some malformed HTML here:
"<p/>"
Presumably, this should be:
"<p>The inputted e-mail <strong>" & CaptureEmail & "</strong> does not appear to be a valid Email_Address.</p>" & _
"<p>Would you like to recheck it before adding it?</p>"
You also seem to be mixing data types -
You initially assign the value of the form control Other_Email to your variable CaptureEmail:
CaptureEmail = Me.Other_Email
And you then treat CaptureEmail as an integer:
If CaptureEmail = 0 Then
Exit Sub
ElseIf CaptureEmail > 0 Then
However, based on the content of the message box, it would imply that CaptureEmail actually contains a string:
The inputted e-mail " & CaptureEmail & " does not appear to be a valid Email_Address.
A few other observations about your code:
If CaptureEmail = 0 Then
Exit Sub
ElseIf CaptureEmail > 0 Then
Given that you only wish to proceed when CaptureEmail is greater than zero, only test is required:
If CaptureEmail > 0 Then
...
End If
Similarly, later in the code, you have the following:
If ValidateEmail(Me.Other_Email) = False Then
...
ElseIf ValidateEmail(Me.Other_Email) = True Then
Exit Sub
End If
Since ValidateEmail returns a boolean value with only two possible values, it is not necessary to test both since if the return is not False, then it must be True and vice-versa.
As such, the code may become:
If Not ValidateEmail(Me.Other_Email) Then
...
End If
The same logic could be applied here:
If (ClickResult = vbYes) Then
Cancel = True
ElseIf (ClickResult = vbNo) Then
Exit Sub
End If
Since, for any result other than vbYes, you aren't performing any action.
i hope i understood correctly and it helps, you want "Would you like to recheck it before adding it?" to be bold as well.
Then you need to encapsulate the same between the tags<strong></strong>
The same way [CaptureEmail] is in between those tags in your code
I'm currently building a form where a user can look up a tool based on the description or part number.
I want user to be able to type any letters into the combobox that I have tied to a query listing all my tools and the combobox will repopulate itself with the tools most similar to what is present in their combobox. For example, if they start typing wre, then tools that have similar characters will start appearing in the combobox such as wrench, torque wrench, power wrench, etc.
I've tried looking around for other people's solutions to this but either I didn't fully comprehend the existing solution (I'm fairly new to Access) or it wasn't what I was looking for. I've seen that people suggested using a listbox instead but I really don't want to go down that route.
I was thinking about using what the user types in the combobox and my VBA code will pick up the "change event" and requery the combobox on the fly by using their input as the like criteria for the new query.
Is this a possible route? Will it be slower? Is there a better route?
I'm hoping someone can show some examples on how to achieve what I'm looking for.
The search as you type feature is very useful! With a textbox and a listbox, you can setup a dynamic search tool that will filter a list for approximate matches as you type. The textbox has four events associated with it, as seen here.
The code behind the form looks like this. Pay attention to the part in bold. This is where we create a string of SQL commands, and utilize the SQL Like operator, to get dynamic matches as we type. Pay attention to the text in bold below.
Option Compare Database
Option Explicit On
Private blnSpace As Boolean 'INCLUDE THIS LINE ON YOUR FORM
Private Sub btnClearFilter_Click()
'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
On Error Resume Next
Me.txtSearch.Value = ""
txtSearch_Change()
End Sub
Private Sub txtSearch_Change()
'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
Dim strFullList As String
Dim strFilteredList As String
If blnSpace = False Then
Me.Refresh 'refresh to make sure the text box changes are actually available to use
'specify the default/full rowsource for the control
strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"
'specify the way you want the rowsource to be filtered based on the user's entry
strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
"*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"
'run the search
fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
'IN WHICH CASE WE WANT TO IGNORE THE INPUT
On Error GoTo err_handle
If KeyAscii = 32 Then
blnSpace = True
Else
blnSpace = False
End If
Exit Sub
err_handle:
Select Case Err.Number
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
End Select
End Sub
Private Sub txtSearch_GotFocus()
' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
On Error Resume Next
If Me.txtSearch.Value = "(type to search)" Then
Me.txtSearch.Value = ""
End If
End Sub
Private Sub txtSearch_LostFocus()
' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
On Error Resume Next
If Me.txtSearch.Value = "" Then
Me.txtSearch.Value = "(type to search)"
End If
End Sub
Finally, in a regular module, you will need this script.
Option Compare Database
Option Explicit On
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software http://www.opengatesw.net
Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search
On Error GoTo err_handle
'restore the cursor to where they left off
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
If ctlSearchBox.Value <> "" Then
'Only fire if they've input more than two characters (otherwise it's wasteful)
If Len(ctlSearchBox.Value) > iSensitivity Then
ctlFilter.RowSource = strFilteredSQL
If ctlFilter.ListCount > 0 Then
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
Else
If blnEmptyOnNoMatch = True Then
ctlFilter.RowSource = ""
Else
ctlFilter.RowSource = strFullSQL
End If
End If
Else
ctlFilter.RowSource = strFullSQL
End If
Else
ctlFilter.RowSource = strFullSQL
End If
'if there is a count label, then update it
If IsMissing(ctlCountLabel) = False Then
ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
End If
Exit Function
err_handle:
Select Case Err.Number
Case 91 'no ctlCountLabel
'exit
Case 94 'null string
'exit
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
End Select
End Function
The code comes from this link:
http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html
Stressed out manager trying to fix a problem in our organisational CRM.
We have a macro set up to send 'ad hoc' text messages to clients. The character limit for the text input is 160, and if you exceed that, a msgbox pops up to tell you to reduce your text by x characters.
When you hit OK, it then kills the entire input box (so you have to re-type a new shorter version of your original message).
How can I set it up so that if you exceed the character limit, it tells you and then gives you the opportunity to go back and delete a few characters?
This is the portion of code I think is relevant:
set msgEntryDlg = CreateDialog("Adhoc SMS")
set msgTxtCtl = msgEntryDlg.AddControl("SMS Message: ",2, "")
if NOT msgEntryDlg.Execute then
Msgbox "Message cancelled!"
Exit sub
end if
mail_message = msgTxtCtl.Text
mail_message = " " + mail_message
If Len(mail_message) < 1 Then
MsgBox "Message was empty, please enter a message!"
Exit Sub
End If
If Len(mail_message) > 160 Then
MsgBox "Message is too long, please reduce by " & (len(mail_message) - 160) & " characters.",4112
Exit Sub
End If
I think it's something to do with a loop ... but I am clueless!
Thanks in advance.
Untested, but I believe you're looking for something like this:
Dim success As Boolean
Do
Set msgEntryDlg = CreateDialog("Adhoc SMS")
Set msgTxtCtl = msgEntryDlg.AddControl("SMS Message: ", 2, "")
If Not msgEntryDlg.Execute Then
MsgBox "Message cancelled!"
Exit Do
End If
mail_message = msgTxtCtl.Text
mail_message = " " + mail_message
If Len(mail_message) < 1 Then
MsgBox "Message was empty, please enter a message!"
End If
If Len(mail_message) > 160 Then
MsgBox "Message is too long, please reduce by " & (Len(mail_message) - 160) & " characters.", 4112
End If
success = True
Loop Until success
If you need to repeat an action until a condition is met, check for the condition at the end of each loop. Note that the cancellation exits the Do, not the Sub.
When trying to print a report in my vb.net project, I have some code to check whether all of the required fields have been filled in. If it isn't, a message box appears to notify the user. When they press 'OK', I need the program to stop executing the code to load the report. At the moment, it is stuck in an infinite loop, where it goes through a Try function and a SELECT CASE repeatedly instead.
What needs changing to stop this? I can't work out what the issue is, and why the following sections of code keep looping round one after the other
Try
Select Case checkwhat.ToUpper
Case "SUPPLIER"
If cmbSuppliers.Text.Trim = "" Then
MsgBox("Please select a supplier", MsgBoxStyle.OkOnly, "No Supplier Selected")
Return False
Exit Try
End If
Case "RB6B"
check("SUPPLIER")
If check("SUPPLIER") = True Then Else Exit Sub
createWorkTable("SUPPLIERS-TERRITORY-LS")
regReport("rTerritoryWTableCrosstabB.rpt", "", con, Me.MdiParent, cReport, True)
fillPms(cReport, "Sales by Territory by Supplier", "For " & cmbSuppliers.Text.Trim, "", "AOT02")
This is not a full answer but I can at least address some issues:
Select Case checkwhat.ToUpper
Case "SUPPLIER"
If cmbSuppliers.Text.Trim = "" Then
MsgBox("Please select a supplier", MsgBoxStyle.OkOnly, "No Supplier Selected")
Return False
Exit Try '<- Redundant
Else
' Perform other checks
Return True
End If
So this means you can at least get both return values assuming you enter the supplier case.
Now.. In your RB6B case, you run the check function twice.
Case "RB6B"
check("SUPPLIER")
If check("SUPPLIER") = True Then
The two options you have are:
Dim supplierValid as Boolean = check("SUPPLIER")
If supplierValid = True
Or just removing the first line
If check("SUPPLIER") = True Then
Okay. So following that:
If check("SUPPLIER") = True Then Else Exit Sub
Try and avoid using this style, because it can hide code paths and you may miss some functionality without realising. Two options shown below. One avoids additional nesting
If check("SUPPLIER") = True Then
createWorkTable("SUPPLIERS-TERRITORY-LS")
regReport("rTerritoryWTableCrosstabB.rpt", "", con, Me.MdiParent, cReport, True)
fillPms(cReport, "Sales by Territory by Supplier", "For " & cmbSuppliers.Text.Trim, "", "AOT02")
Else
Exit Sub
End If
Or
If check("SUPPLIER") = False Then
Exit Sub
End If
createWorkTable("SUPPLIERS-TERRITORY-LS")
regReport("rTerritoryWTableCrosstabB.rpt", "", con, Me.MdiParent, cReport, True)
fillPms(cReport, "Sales by Territory by Supplier", "For " & cmbSuppliers.Text.Trim, "", "AOT02")
I have a form with multiple list boxes and all work fine save 1! This is the only list box whose source is number data-type. I know this shouldn't matter, but what I'm seeing is that for this list box only the variant returned is always 1, and I cannot understand why the others (data-type text) work properly and this one doesn't. All of my Google searches and MSN searches and here on StackOverflow have not helped my specific issue though there's a LOT out there about ListBoxes. Please help!
Edit: Sorry #Mat's Mug...I was hoping that wouldn't be necessary as it's lengthy with all the checking going on, but here's the gist.
For Each ctl In Form.Controls
With ctl
Select Case .ControlType
Case acListBox
If .Visible = True Then
.SetFocus
ItemCount = .ItemsSelected.Count
If .ItemsSelected.Count > 0 Then
For Each varItm In .ItemsSelected
If .Name = "lstRating" Then
sWhereClause = sWhereClause & "ThisRating=" & .ItemData(varItem) & " Or ThatRating = " & .ItemData(varItem)
Else
sWhereClause = sWhereClause & Mid(.Name, 4, Len(.Name)) & " = """ & .ItemData(varItm) & """"
End If
Next varItm
End If
End If
End Select
End With
Next ctl
Note: When .Name = "lstRating" is True is the line where varItem returned is 1 regardless of what is selected. The list box is populated with values from 1 to 5 in 0.5 increments.
Well, I can't believe I was overlooking it for hours...I was using varItem in the offending line when it's defined at varItm, no "e"! TOTALLY an oversight on my part. Thanks all for looking into this!