I have the below code that when it runs updates 14 tables, wondering how can I show a msg using the text boxes in the template below showing whether the subs end successfully or not.
[Private Sub Command0_Click()
'Sub 1
A_Forecast
'Text box showing the msg OK or failed
A_ForecastTxt "OK" or "Not"
'Sub 2
B_Forecast
'Text box showing the msg OK or failed
B_ForecastTxt "OK" or "Not"
End Sub][1]
Turn the subs into functions as these can return a value:
Private Sub Command0_Click()
Dim Success As Boolean
' Function 1
Success = A_Forecast
' Text box showing the msg OK or failed
MsgBox IIf(Success, "OK", "Failed")
' Function 2
Success = B_Forecast
' Text box showing the msg OK or failed
MsgBox IIf(Success, "OK", "Failed")
End Sub
Example:
Public Function A_Forecast() As Currency
Dim Result As Currency
Dim Something As Boolean
' Your code:
Something = True ' or False
If Something = True Then
Result = 100
Else
Result = 200
End If
A_Forecast = Result
End Function
Related
I have a database with the following
Mainfrm Form (Main Form - it has popup messages on load event)
kikThemOut Form (Loads hidden with Main Form and every 5 sec it checks for field value on table if it is 1 then call the Function fGetOut())
GetOutMod Module (has fGetOut() Function)
it works all fine, except when application closing it loads the popup alerts from Mainfrm again! which should not load.
Mainfrm Form Code
Private Sub Form_Load()
'to check for T&I notifications
Dim trs As Recordset
Set trs = CurrentDb.OpenRecordset("Y22_CurrMonth")
If trs.EOF = False Then
Dim tMsg, tStyle, tTitle, tHelp, tCtxt, tResponse, tMyString
tMsg = "There are Notifications Due, Do you want to view them?"
tStyle = vbYesNo + vbExclamation + vbDefaultButton2
tTitle = "Notifications Alert"
tHelp = "DEMO.HLP"
tCtxt = 1000
tResponse = MsgBox(tMsg, tStyle, tTitle, tHelp, tCtxt)
If tResponse = vbYes Then ' User chose Yes.
DoCmd.OpenReport "Notifications Current Month", acViewReport, acWindowNormal
Else
tMyString = "No"
End If
End If
'to load the checker form
DoCmd.OpenForm "kikThemOut", , , , , acHidden
End Sub
and this is the GetOutMod Module to force users to exit the db
GetOutMod Module
Option Compare Database
Option Explicit
Function fGetOut() As Integer
Dim RetVal As Integer
Dim db As DAO.Database
Dim rst As Recordset
On Error GoTo Err_fGGO
Set db = DBEngine.Workspaces(0).Databases(0)
Set rst = db.OpenRecordset("KickEmOff", dbOpenSnapshot)
If rst.EOF And rst.BOF Then
RetVal = True
GoTo Exit_fGGO
Else
If DSum("GetOut", "KickEmOff") = "1" Then
Application.Quit
Else
RetVal = True
End If
End If
Exit_fGGO:
fGetOut = RetVal
Exit Function
Err_fGGO:
'Note lack of message box on error
Resume Next
End Function
And this code in the load event of kikThemOut form to check for the same condition, if it is 1 then load this popup message (I could not add popup message to my GetOutMod Module with the function fGetOut)
kikThemOut form Code
Private Sub Form_Timer()
If DSum("GetOut", "KickEmOff") = "1" Then
Set TaskDialogAC = New cTaskDialog
With TaskDialogAC
.Init
.MainInstruction = "Dashboard Maintenance"
.Flags = TDF_CALLBACK_TIMER
.Content = "The Dashboard will be closed after 20 seconds for maintenance"
.CommonButtons = TDCBF_CLOSE_BUTTON
.IconMain = IDI_WINLOGO
.Footer = "Closing in 20 seconds..."
.Title = "Dashboard Maintenance"
.AutocloseTime = 20 'seconds
.ParenthWnd = Me.hwnd
.ShowDialog
End With
Call fGetOut
Else
If DSum("GetOut", "KickEmOff") = "0" Then
DoCmd.Requery
End If
End If
End Sub
Really hard to read your code and figure out where your function is being called from.
But I'm assuming this should work for you as described
Add this before your fGetOut function
Public blClosing as Boolean
And then add this inside your function at the top (after On Error GoTo Err_fGGO)
if blClosing then
blClosing = False
Exit function
Else
blClosing = True
End if
I am writing a VBA code using a useform, which includes 3 ComboBoxes and 3 TextBoxes.
Whenever a user chooses any value from the list provided by the Comboboxes, the code works. The problems start when I try to combine a Combobox user's choice with any textbox.
I have assigned restrictions to the textboxes with a matching message box to pop up whenever the restriction is recognized, but when an appropriate value is typed into a textbox - I get a:
runtime error '91': Object variable or With block variable not set
While I don't have anything declared as an object or any "With" process throughout the entire code.
My code is:
Note: Num_Molecules is the combobox name, Molecules_Hand is the textbox name.
Private Sub Insert_Molecules_Click()
Dim lMolecules As Single
If Not Len(Trim(Num_Molecules.Value)) = 0 And Len(Trim(Molecules_Hand.Text)) = 0 Then
lMolecules = Val(Num_Molecules.Value)
ElseIf Len(Trim(Molecules_Hand.Text)) = 0 And Len(Trim(Num_Molecules.Value)) = 0 Then
Molecules_Hand.Text = ""
MsgBox "enter num of molecules"
'Exit Sub
ElseIf Molecules_Hand.Value < 5 And Len(Trim(Num_Molecules.Value)) = 0 Then
Molecules_Hand.Text = ""
MsgBox "value cannot be under 5"
'Exit Sub
ElseIf Molecules_Hand.Value >= 5 And Len(Trim(Num_Molecules.Value)) = 0 Then
If Not Val(Molecules_Hand.Value) = Int(Val(Molecules_Hand.Value)) Then
MsgBox "number must be an integer"
'Exit Sub
ElseIf IsNumeric(Molecules_Hand.Value) = False And Len(Trim(Num_Molecules.Value)) = 0 Then
MsgBox "textbox or choice cannot be empty"
'Exit Sub
End If
Else
lMolecules = Index_Form.Molecules_Hand.Value
End If
End Sub
The problem is with the last line before the "End If" - it just won't assign the textbox value to the variable. I have the same problem with all of my 3 textboxes and they are all assigned in the same way.
I'd appreciate your help.
i can not figure this out below is the code.... I hit the error for the 2nd case to open the form frmBookingLCL.show the form name is correct. I can't figure this out. the line with the **** us the error line. HELP!!
Public Sub SendBookingEmail()
StartTime = Timer
With Session
'check first 2 letters of shipper's code, if not US raise error
If IsStartPositionCorrect(5, 14, 2, "US") <> True Or IsStartPositionCorrect(5, 2, 8, "Customer") <> True And GetDisplayText(4, 20, 1) <> "0" Then
If MsgBox("You don't appear to be in Logis ocean export US file. Please enter the file first and then run the macro.", vbOKOnly, "Export file verification....") Then
Exit Sub
End If
End If
sTypeOfMessage = "booking"
sShipmentType = Trim(.GetDisplayText(9, 61, 3))
sFileType = Trim(.GetDisplayText(4, 32, 1))
bFullVersion = False
'On Error GoTo ErrHand
'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
'collect data fields for the e-mail body
GetAllLogisDataBooking
'Blow up the question form
Select Case sShipmentType
Case "FCL", "CMF", "CCS", "FPR"
frmBookingFCL.Show
Case "LCL", "GWY", "CLD"
frmBookingLCL.Show**********ERROR HERE
Case Else
frmBookingFCL.Show
'frmBookingOthers.Show
End Select
End With
Finish = Timer
TimeTook = Finish - StartTime
MyMacroStats = GetProcedureStats("Booking Confirmation", TimeTook)
Exit Sub
ErrHand:
If Err = 429 Then
MsgBox "Please note you must start Microsoft Outlook first."
End
End If
End Sub
Most likely, the error is in your user form. See the code comments.
I tried to replicate the issue below:
Sub test()
'/Sub to load the user form.
Dim x As String
x = "a"
Select Case x
Case "a", "b", "c"
UserForm1.Show '/ It Will error-out here during debugging.
End Select
End Sub
Code in UserForm1
Private Sub UserForm_Initialize()
'/ Code from : https://msdn.microsoft.com/en-us/library/office/gg251554.aspx
'/ Actually the error happens here.
Dim RetVal ' Implicitly a Variant.
' Default property is assigned to Type 8 Variant RetVal.
RetVal = CreateObject("Excel.Application")
RetVal.Visible = True ' Error occurs here.
End Sub
So going by your intialize code, either you are missing or have incorrect name for one of these controls.
frTrucker,CheckBox1,txtPickupDate. Once you correct them, the error will be gone.
I want to compare the IF argument to a string array. The user will try to put in a teamname into a textbox, if the user uses a swear word anywhere within that textbox, it will display an error message and clear the textbox. If the user has not sworn, it will register the teamname and carry on with the program (As can be seen in the 2nd IF statement). I have tried to get this code to work for a week now and cannot get it to work.
Private Sub SelectionButtonEnter_Click(sender As Object, e As EventArgs) Handles SelectionButtonEnter.Click
Dim HasSworn As Boolean = False
Dim swears() As String = {"Fuck", "fuck", "Shit", "shit", "Shite", "shite", "Dick", "dick", "Pussy", "pussy", "Piss", "piss", "Vagina", "vagina", "Faggot", "faggot"} 'Declare potential swear words the kids can use
For Each swear As String In swears
If InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
SelectionTextBoxTeamName.Clear() 'Clear the textbox
MessageBox.Show("Remember ... You can be disqualified, raise your hand and Blair will set up the program for you again") 'Let the user know they have entered a swear word and ask them to select another team name
End If
If Not InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
Timer1.Enabled = True 'Enable timer 1 for the learn box
Timer3ForSelection.Enabled = True 'Enable this timer to show the learn button
TeamName = SelectionTextBoxTeamName.Text() 'Once this button has been pressed, store the content of that textbox in a the TeamName string
SelectionLabelTeamName.Text = "Welcome " & SelectionTextBoxTeamName.Text & " Please click 'Learn' in the box below to begin" 'Display the contents of the string along with other text here
SelectionLabelTeamNameTL.Text() = "Team Name: " & TeamName 'Display the contents of the string along with other text here
SelectionTextBoxTeamName.BackColor = Color.Green 'Have the back color of the box set to green
SelectionTextBoxTeamName.Enabled = False 'Do not allow the user/users enter another team name
End If
Next 'A next must be declared in a for each statement
End Sub
Thanks in advance.
I don't think I'd approach it that way; if the user types f**kyou, your code wouldn't catch it. How about this instead:
In your code:
If ContainsBannedWord(SelectionTextBoxTeamName.Text) Then
Msgbox "Hold out your hand, bad person. SlapSlapSlap"
Else
Msgbox "Good boy!"
End if
Function ContainsBannedWord(sInput As String) As Boolean
Dim aBannedWords(1 To 5) As String
Dim x As Long
' Make all the banned words capitalized
aBannedWords(1) = "BANNED1"
aBannedWords(2) = "BANNED2"
aBannedWords(3) = "BANNED3"
aBannedWords(4) = "BANNED4"
aBannedWords(5) = "BANNED5"
For x = LBound(aBannedWords) To UBound(aBannedWords)
If InStr(UCase(sInput), aBannedWords(x)) > 0 Then
ContainsBannedWord = True
Exit Function
End If
Next
ContainsBannedWord = False
End Function
I need to select all the text in a textbox of an Access form when I click (or double click) into it. i tried the following code, unsuccessfully:
Me.txt_CompraPreco.SelStart = 0
Me.txt_CompraPreco.SelLength = Len(Me.txt_CompraPreco)
thanks in advance.
You can use the code shown below. If it doesn't work, place a breakpoint at the first line of code. If it doesn't stop on your breakpoint, then your event is not recognized.
Option Compare Database
Option Explicit
Private Sub txt_CompraPreco_Click()
If Len(Me.txt_CompraPreco & "") = 0 Then Exit Sub
Me.txt_CompraPreco.SelStart = 0
Me.txt_CompraPreco.SelLength = Len(Me.txt_CompraPreco)
End Sub
I was looking for a solution regarding this problem, I have the same issue, however, I have a solution to it, I'm not sure if it's efficient, but here's my code:
'Declare a flag
Public flagDblClick As Boolean
'Double click event
Private Sub txtbox_DblClick (Cancel As Integer)
flagDblClick = True
End Sub
'Mouse up Event
Private Sub txtbox_MouseUp(Button As Integer, Shift As Integer, X as Single, Y as Single)
If flagDblClick Then
flagDblClick = False
txtBox.SelStart = 0
txtBox.SelLength = Len(txtBox.Value)
End If
End Sub
This code will resolve your problem (use with userform).
txt_CompraPreco.SetFocus
Me.txt_CompraPreco.SelStart = 0
Me.txt_CompraPreco.SelLength = Len(Me.txt_CompraPreco)
My trial and error found this.
If your textfield is formatted as a Standard Number and you have set the decimal places to a certain length, you will run into trouble when you enter a single digit. For example if your decimal places in the field properties is set to 2 and you enter "1", you will display "1.00". To get the entire field (1.00) selected, you must specify the .Text property when you determine the .SelLength (not the default .Value property)
Me.txtYourFieldname_GotFocus
Me.txtYourFieldName.SelStart = 0
Me.txtYourFieldName.SelLength = Len(Me.txtYourFieldName.Text)
End Sub
This works for me:
Dim bSelect As Boolean
Private Sub fieldX_Click()
If bSelect Then
'Select text only at first mouse click then user can click again
'and is able to put mouse pointer where he prefers
Me.fieldX.SelStart = 0
Me.fieldX.SelLength = Len(Me.fieldX)
bSelect = False
End If
End Sub
Private Sub fieldX_GotFocus()
bSelect = True
'Select text if field got focus via keyboard, Enter or TAB
'this is not enough if field got focus via mouse click
Me.fieldX.SelStart = 0
Me.fieldX.SelLength = Len(Me.fieldX)
End Sub