I use ms access vba to create my program and I don't like default msgbox design , so I create a form named "frm_msg"
look like this >>>
and I make a simple function with arguments to call this form
Public Function custom_msg(msg_title, msg_txt, msg_icon, msg_button As String)
DoCmd.OpenForm "frm_msg"
Form_frm_msg.lbl_msg_title.Caption = msg_title
Form_frm_msg.lbl_msg_txt.Caption = msg_txt
If msg_icon = "success_icon" Then
Form_frm_msg.success_icon.Visible = 1
Form_frm_msg.error_icon.Visible = 0
Form_frm_msg.warning_icon.Visible = 0
Form_frm_msg.question_icon.Visible = 0
ElseIf msg_icon = "error_icon" Then
Form_frm_msg.success_icon.Visible = 0
Form_frm_msg.error_icon.Visible = 1
Form_frm_msg.warning_icon.Visible = 0
Form_frm_msg.question_icon.Visible = 0
ElseIf msg_icon = "warning_icon" Then
Form_frm_msg.success_icon.Visible = 0
Form_frm_msg.error_icon.Visible = 0
Form_frm_msg.warning_icon.Visible = 1
Form_frm_msg.question_icon.Visible = 0
ElseIf msg_icon = "question_icon" Then
Form_frm_msg.success_icon.Visible = 0
Form_frm_msg.error_icon.Visible = 0
Form_frm_msg.warning_icon.Visible = 0
Form_frm_msg.question_icon.Visible = 1
End If
If msg_button = "ok" Then
Form_frm_msg.btn_ok.Visible = 1
Form_frm_msg.btn_yes.Visible = 0
Form_frm_msg.btn_no.Visible = 0
ElseIf msg_button = "yes_no" Then
Form_frm_msg.btn_ok.Visible = 0
Form_frm_msg.btn_yes.Visible = 1
Form_frm_msg.btn_no.Visible = 1
End If
End Function
now my problem is how do I make it return a value depending on the button that I click?
and use it like default msgbox in if statement
if msgbox("Hallo world",vbInformation+ vbYesNo ,"Hallo") = vbYes Then
'do something ...
end if
The easiest way I found to do this reliably is to place a hidden text box on the form to hold your 'return' value. (I found this more reliable as you can control default value, type etc and draw conclusions from NULL etc which you can't from using a TempVar)
Now write yourself a simple wrapper function which opens the form in dialog mode. In the OnClick event of your buttons, set the hidden text control value to the return value you want, and then hide (don't close) the form. Because it was dialog, it will still be open but not visible, and control flow returns to your wrapper function.
Obtain the value from the hidden text field on the form using a fully qualified reference to the text control, store it in a variable in the wrapper function and do something with it if required, or just return it as is (like the example), then close the form programmatically using DoCmd.Close.
Something simple like this;
Form_Name is the full name of your form
NameOfTextControl is the name of the hidden control set by your onClick event
Function customBox(msg_title, msg_txt, msg_icon, msg_button) as string
'I would usually pass a delimited string of values in the OpenArgs
'or set TempVars if necessary, then use your function code inside
'the form Open event to configure the form dynamically before displaying
DoCmd.OpenForm "Form_Name", acNormal, , , , acDialog
' When we get back here, the form is invisible, not closed
customBox = Forms!Form_Name!NameOfTextControl
DoCmd.Close acForm, "Form_Name", acSaveNo
End Function
So all you then do is replace msgbox with your customBox function and adjust the vbYes / vbNo constant to check for whatever value you set in the form
if customBox(msg_title, msg_txt, msg_icon, msg_button) = "Yes" Then
'do something ...
end if
You can use a module and global/public variables to interact with the form.
Here is a snippet from my project:
' Opens a message box, using form ModernBox, similar to VBA.MsgBox.
'
' Syntax. As for MsgBox with an added parameter, TimeOut:
' MsgMox(Prompt, [Buttons As VbMsgBoxStyle = vbOKOnly], [Title], [HelpFile], [Context], [TimeOut]) As VbMsgBoxResult
'
' If TimeOut is negative, zero, or missing:
' MsgMox waits forever as MsgBox.
' If TimeOut is positive:
' MsgMox exits after TimeOut milliseconds, returning the result of the current default button.
'
' 2018-04-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function MsgMox( _
Prompt As String, _
Optional Buttons As VbMsgBoxStyle = vbOkOnly, _
Optional Title As Variant = Null, _
Optional HelpFile As String, _
Optional Context As Long, _
Optional TimeOut As Long) _
As VbMsgBoxResult
' Set global variables to be read by form ModernBox.
mbButtons = Buttons
mbPrompt = Prompt
mbTitle = Title
mbHelpFile = HelpFile
mbContext = Context
Call OpenFormDialog(ModernBoxName, TimeOut)
' Return result value set by form ModernBoxName.
MsgMox = mbResult
End Function
The full code is way too much to post here, so feel free to browse VBA.ModernBox for all the details.
Related
I set up a public function. It is meant to lock and gray a date control, unless its corresponding combo box control is set to a (bound) value of 2. I made this a public function, so I can call it on load of the form, on current, which fires when the form is navigated back or forth, and when the combo changes. I also have to do this for 2 sets of paired combos and date controls, so having it in a function makes it easier to call for any form/control pairing, when I need to.
This is the public function:
Public Function DateFieldStatus(frm As Form, fkctl As Control, dtctrl As Control)
'Combo Status Values
'ID Combo
'1 = not ok
'2 = ok
'3 = not ok
Select Case frm.fkctl
Case 2
frm.dtctrl.Locked = False
frm.dtctrl.ForeColor = RGB(255, 255, 255)
Case Else
frm.dtctrl.Locked = True
frm.dtctrl.ForeColor = RGB(214, 214, 214)
End Select
frm.dtctrl.Requery
End Function
I have it set to call on load of the main form like this:
Private Sub Form_Load()
If DCount("ID", "tblMainTable") = 0 Then
DoCmd.GoToRecord , , acNewRec
Else
DoCmd.GoToRecord , , acFirst
End If
Me.FirstControl.SetFocus
DateFieldStatus Me.Form, Me.FKDropDown1, Me.dtDateControl1
End Sub
When Launch the main form, I get the following error:
Run-time error '2465':
Application-defined or object-defined error
When I debug, it hightlights this line of the public function:
Select Case frm.fkctl
I'm assuming it doesn't like me combining a form parameter with a control parameter.
Is that not something you can do?
Is there a better way to do this?
Thanks for any help!
frm.fkctl is looking for a control named "fkctl" on the form, and not finding it obviously.
You don't need to pass frm to the function at all - the control object fkctl is sufficient to address the control.
Simply do:
Select Case fkctl.Value
and it will work.
You could do
frm(fkctl.Name)
but it would be kinda silly.
Thanks, I realized I didn't need to declare the form. I declare the control, and when I call the function, the form is . Here is the final solution:
Public Function -
Public Function SmokerStatus(fkctl As Control, dtctrl As Control)
Dim Msg, Style, Title, Response
'ID Combo
'1 = not ok
'2 = ok
'3 = not ok
Msg = "You have changed the option status" & vbCrLf & _
"to a status that doesn't require an option date." & vbCrLf & _
"The corresponding option date has a value. " & vbCrLf & _
"If you would like to delete that date, click yes, otherwise click no, and we will undo."
Style = vbYesNo
Title = "Option Date Only Applies to PAST Option Status"
Select Case fkctl
Case 2
dtctrl.Locked = False
dtctrl.BackColor = RGB(255, 255, 255)
Case Else
If Nz(dtctrl, "") = "" Then
dtctrl.Locked = True
dtctrl.BackColor = RGB(214, 214, 214)
Else
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
dtctrl.Value = ""
dtctrl.Locked = True
dtctrl.BackColor = RGB(214, 214, 214)
Else
fkctl.Undo
End If
End If
End Select
dtctrl.Requery
End Function
Here is an example of calling it -
OptionStatus Me.FKOptionCombo, Me.dtOptionDate
Hope this helps others.
I have an excel workbook where the user imports text files into a "Data Importation Sheet". The number of files imported is dependent on how files the user wants to import. So far my workbook works great but I have hit one bump. When the user imports a file an identifier (i.e. 1, 2, 3, etc) gets assigned to that data set. Then the user selects an option from a dropdown box and calculations and plots will automatically be produced. The user also has the option to "Clear all data" where when this is selected all worksheets are cleared and if the user imports new files (after clicking the "clear all data" button) the identifier value restarts at 1. Here is my code for the identifier/counting how many files have been imported..
Public Sub Macro(Optional reset As Boolean = False)
Static i As Integer
If reset Then
i = -1
i = i + 1
Exit Sub
End If
i = i + 1
Worksheets("Hidden").Cells(i + 1, 1).FormulaR1C1 = "=" & i
Worksheets("Hidden").Cells(2, 2).FormulaR1C1 = "=" & i
End Sub
The problem I have ran into now is data will need to be imported into this sheet at a later date so when I save this file and reopen it then import more files the identifier/count for file imports restarts at 1 which I do not want to happen. I want to be able to just keep adding more files and have the code continue, I do not want to have to clear all the imported data and restart. Any ideas as to how I can do this? TIA.
I'd create a standalone function to manage the sequence. Store the value in a Workbook Name entry.
Note - if you had to manage multiple sequences you could promote the name of the sequence to a parameter instead of using a Constant within the Function.
Function NextSequence(Optional reset As Boolean = False)
Const COUNTER_NAME As String = "NM_COUNTER"
Dim nm As Name, i
On Error Resume Next
'is the name already created?
Set nm = ThisWorkbook.Names(COUNTER_NAME)
On Error GoTo 0
If nm Is Nothing Then
'not there yest - create it...
Set nm = ThisWorkbook.Names.Add(COUNTER_NAME, 0)
End If
If Not reset Then
i = Evaluate(nm.RefersTo)
i = i + 1
nm.RefersTo = i
Else
nm.RefersTo = 0
i = 0 '<< or 1 if you want NextSequence(True) to
' return the first sequence value
End If
NextSequence = i
End Function
Usage:
Public Sub Macro(Optional reset As Boolean = False)
Dim i
i = NextSequence(reset)
If reset Then Exit Sub
With Worksheets("Hidden")
.Cells(i + 1, 1).Value = i
.Cells(2, 2).Value = i
End With
End Sub
A quick fix for this would be to store the value of the identifier/count inside a cell and hide/lock the cell. The value inside the cell won't change upon restart yet you still can manipulate it inside VBA.
Very quick feel of how it should look like (probably innacurate as I don't have every info I need.)
Public Sub Macro(Optional reset As Boolean = False)
Static i As Integer
i = ActiveWorkBook.Sheets("Ressource").Range("A1").Value
If reset Then
i = -1
i = i + 1
Exit Sub
End If
i = i + 1
Worksheets("Hidden").Cells(i + 1, 1).FormulaR1C1 = "=" & i
Worksheets("Hidden").Cells(2, 2).FormulaR1C1 = "=" & i
End Sub
You could also create a CustomDocumentProperty to save the sequence number. You can pass a boolean to the method to reset:
Lastly, a helper function will check if the property exists, in order to be added if not.
Public Sub SequenceNumber(Optional ByVal Reset As Boolean = False)
If Not PropertyExists("Identifier") Then
ThisWorkbook.CustomDocumentProperties.Add Name:="Identifier", _
LinkToContent:=False, _
Type:=msoPropertyTypeNumber, _
Value:=0
End If
Dim p As Object
Set p = ThisWorkbook.CustomDocumentProperties("Identifier")
If Reset Then p.Value = 0 Else p.Value = p.Value + 1
End Sub
'Property Exists?
Private Function PropertyExists(ByVal propertyName As String) As Boolean
Dim p As Object
For Each p In ThisWorkbook.CustomDocumentProperties
If p.Name = propertyName Then
PropertyExists = True
Exit Function
End If
Next p
End Function
To call it:
SequenceNumber
SequenceNumber Reset:=True
I want to set up a public function like the following:
(A)
Public Function CheckYNField(chkControl As Control, chkField As String)
If chkField = "Y" Then
chkControl = -1
ElseIf chkField = "N" Then
chkControl = 0
Else: chkControl = 0
End If
End Function
(B)
Public Function CheckYNFlipper(chkControl As Control, chkField As String)
If chkField = "Y" Then
chkField = "N"
chkControl = 0
ElseIf chkField = "N" Then
chkField = "Y"
chkControl = -1
Else: chkField = "Y"
chkControl = -1
End If
End Function
The reason for this is, that I have a form, which has an underlying SQL table. I have no control over the data, but I must represent it, for the ability to maintain it. I have 10 fields, in the underlying table, which have a Y or N as their values. The data types are actually nvarchar(10). At the same time, I have to show these fields as checkbox controls, on the form, for ease of use.
The above code, is an attempt I am making to A - set the checkbox control to align with the current value in the table--> -1 = Y and 0 = N, and to B - update the table value, and switch the check box to checked or unchecked, from what it was, to the opposite, based on the onclick event of that control.
I want to make chkField and chkControl variables to the public function, that would be the table-field, and the form-control. I can't seem to get the right syntax, and was hoping someone might have clarification on how to do this.
for the form load and current, I tried this:
CheckYNField Forms("frmFormNameA").Controls(chkCheckNameA), tblTableName.FieldA
for the on click, I tried this:
CheckYNFlipper Forms("frmFormNameA").Controls(chkCheckNameA), tblTableName.FieldA
I've tried some other methods, but doesn't seem to be working. I'm doing something wrong, but I can't tell what. Appreciate any tips!
Edit/Update:
I tried Kostas K.'s solution, abandoning the idea of making a public functions with parameters for the fields and controls. I put the following, on load and on current:
With Me
If .txtfieldboundtablefieldA.Value = "Y" Then
.unboundchkA.Value = True
ElseIf .txtfieldboundtablefieldA.Value = "N" Then
.unboundchkA.Value = False
Else: .unboundchkA.Value = False
End If
End With
This is on a continuous form, so that it can show like a giant grid. There are the identifying bound field controls, and then a series of these checkboxes, to display the Y/N true/false status of each of these particular fields. I can't bound the checkboxes to the fields, because it changes the field value in the table to -1 or 0, and we need it to stay Y or N. I added a bound text field, to hold the table/field value for each row (hence the call to a text box control in the above revised code). The checkbox is unbound, and is there to display the field value, and allow the user to check and uncheck, so I can use on-click code to change the table field value between Y and N.
The above code is not seeming to show the correct checkbox value for each bound text field, based on each row. It shows based on the row that currently has focus. If I click on a row, where the table field is Y, all rows checkboxes on the form show true. If I move to a row, where the table field is N, all checkboxes for all rows change to false. I am struggling to just initially get 1 checkbox to show accurately, on every row of the continuous form, based on every record in the table. This is a small table, like 30 records. I really didn't think it would be so difficult to present this the way we need to.
Any ideas, how I could better do this?
Edit:
Set the Control Source of the checkbox to:
= IIf([YourYesNoField] = "Y", -1, 0)
In order to update when clicked:
Private Sub chkCheckNameA_Click()
Dim yesNo As String
yesNo = IIf(Me.chkCheckNameA.Value = 0, "Y", "N") 'reverse value
CurrentDb.Execute "Update [YourTable] SET [YourYesNoField]='" & yesNo & "' WHERE [ID]=" & Me![ID], dbFailOnError
Me.Requery
End Sub
You could try something this.
Check the Y/N field and assign the function's boolean return value to the checkbox (A).
On the checkbox click event, check its value and update the Y/N field (B).
'Form Load
Private Sub Form_Load()
With Me
.chkCheckNameA.Value = CheckYNField(![FieldA])
End With
End Sub
'Click
Private Sub chkCheckNameA_Click()
With Me
![FieldA] = IIf(.chkCheckNameA.Value = 0, "N", "Y")
End With
End Sub
'True returns -1, False returns 0
Private Function CheckYNField(ByVal chkField As String) As Boolean
CheckYNField = (chkField = "Y")
End Function
chkControl is a Control, so you need to access a property of that control. Try changing your code to:
Public Function CheckYNField(chkControl As Control, chkField As String)
If chkField = "Y" Then
chkControl.Value = -1
ElseIf chkField = "N" Then
chkControl.Value = 0
Else: chkControl.Value = 0
End If
End Function
and then the same idea in your other function.
This is the first bit of my VB.NET code:
Private Function CreateEventMWB(pWeek As XmlNode, sEventSettings As GoogleEventSettings, strEventType As String, ByRef rbCreated As Boolean) As My_GoogleEvent
Dim sEvent As My_GoogleEvent
sEvent.strTitle = pWeek.Attributes(kEventTitle).Value()
sEvent.strDate = pWeek.Attributes(kDate).Value()
sEvent.strTime = pWeek.Attributes(kStartTime).Value()
sEvent.strLocation = GetXmlNodeText(pWeek, kSpecialEventLocation)
sEvent.iMeetingDuration = 105 ' 1h 45m
sEvent.bSpecialEvent = GetXmlNodeBoolean(pWeek, kSpecialEvent)
sEvent.bNoMeeting = GetXmlNodeBoolean(pWeek, kNoMeeting)
sEvent.bFirstWeekOfMonth = GetXmlNodeBoolean(pWeek, kFirstWeek)
sEvent.strTag1 = strEventType
sEvent.strTag2 = ""
sEvent.strEventDetails = ""
rbCreated = False
If (Not sEvent.bNoMeeting) Then
' It does not matter if this is a special event (like a circuit visit meeting)
' as it is still a meeting
rbCreated = True
ElseIf (Not sEventSettings.bExcludeSpecialEvents) Then
' We already know there is no meeting for this date.
' Therefore it is going to be a special event. But are we including special events? - Yes!
rbCreated = True
End If
If (rbCreated) Then
' We have one of two scenariors
' 1. It is a normal meeting or a special meeting
' 2. It is a special event (if they were not excluded)
Dim bCreateAsMeeting = True
If (sEvent.bSpecialEvent And sEvent.bNoMeeting) Then
bCreateAsMeeting = False
End If
If (bCreateAsMeeting) Then
AddToEventDetails(sEvent, "IDS_TPL_MWB_GOOGLE_NOTE", sEventSettings.dictLabels, GetXmlNodeText(pWeek, kNote))
The variable sEvent gets correctly filled. The program works - always has done. But the last call in the code AddToEventDetails raises a warning when I compile:
I am not sure exactly how I can prevent the warning.
Thank you.
Self teaching VB beginner here.
I have a data entry section that includes...
2 comboboxes(cbx_TruckType, cbx_DoorNumber)
-------cbx_TruckType having 2 options (Inbound, Outbound)
-------cbx_DoorNumber having 3 options (Door 1, Door 2, Door 3)
2 textboxes (txb_CustomerName, txb_OrderNumber)
-------txb_CustomerName will hold a customer name
-------txb_OrderNumber will hold an order number
and finally...
a button(btn_EnterTruck) that transfers the text from the comboxes and textboxes to the following...
2 Tabs
The 1st tab has
2 buttons(btn_Door1, btn_Door2)
btn_Door1 has 3 corresponding textboxes
-------txb_TruckTypeDoor1, txb_CustomerNameDoor1, txb_OrderNumberDoor1
btn_Door2 has 3 corresponding textboxes
-------txb_TruckTypeDoor2, txb_CustomerNameDoor2, txb_OrderNumberDoor2
The 2nd tab has
1 button(btn_Door3)
btn_Door1 has 3 corresponding textboxes
-------txb_TruckTypeDoor3, txb_CustomerNameDoor3, txb_OrderNumberDoor3
Currently, I have code (that works thanks to another question I had!) that, upon btn_EnterTruck.click, will transfer the text to the corresponding textboxes.
Here's my problem...
I've coded a msgbox to pop-up (when Inbound is selected from the cbx_TruckType) asking if there is an Outbound. If I click "Yes", an inputbox pops-up and asks for an order number. The button then transfers the Inbound information to the textboxes and stores the Outbound order number.
When I click btn_Door1(or 2 or 3), it clears the text from its corresponding textboxes. (Using me.controls)
( I would add code for all of the above, but I figure its a moot point, because it works)
What I want to happen...
I want to have the stored Outbound number to be saved with a reference to which door number it corresponds to. Then upon btn_DoorX click, it will fill that order number into the corresponding textbox. I don't need the text stored/saved when the app is closed.
And I have no idea how to do that.
*After some tooling, I've done the following, but it does not work"
I declared these at the class level.
Dim str_SameTruckPODoor1, str_SameTruckPODoor2, str_SameTruckPODoor3 As String
This code is in the btn_EnterTruck event
Dim str_ErrOutDoorName As String = cbx_DoorNumber.Text
Dim str_OutboundDoorName As String = str_ErrOutDoorName.Replace(" ", "")
Dim ArrayForPONumbers As Control() = Me.Controls.Find("str_SameTruckPO" & str_OutboundDoorName, True)
If cbx_TruckType.Text = "Inbound" Then
Dim OutboundMsg = "Is there an Outbound with this truck information?"
Dim Title = "Outbound?"
Dim style = MsgBoxStyle.YesNo Or MsgBoxStyle.DefaultButton2 Or _
MsgBoxStyle.Question
Dim response = MsgBox(OutboundMsg, style, Title)
If response = MsgBoxResult.Yes Then
Dim NeedPOMessage, NeedPOTitle, defaultValue As String
Dim PONumberOutbound As String
' Set prompt.
NeedPOMessage = "Enter the PO Number"
' Set title.
NeedPOTitle = "PO# For Outbound"
defaultValue = "?" ' Set default value.
' Display message, title, and default value.
PONumberOutbound = InputBox(NeedPOMessage, NeedPOTitle, defaultValue)
' If user has clicked Cancel, set myValue to defaultValue
If PONumberOutbound Is "" Then PONumberOutbound = defaultValue
ArrayForPONumbers(0) = PONumberOutbound
End If
End If
I'm getting an error message on
ArrayForPONumbers(0) = PONumberOutbound ' Cannot convert string to .controls
And I have the following code in the btn_Door1 event - it handles btn_Door2, btn_Door3
Dim WhichButton As Button = CType(sender, Button)
Dim str_ErrDoorName As String = WhichButton.Name
Dim str_DoorName As String = str_ErrDoorName.Replace("btn_", "")
Dim str_DoorType As Control() = Me.Controls.Find("txb_" & str_DoorName & "Type", True)
Dim str_Customer As Control() = Me.Controls.Find("txb_" & str_DoorName & "Customer", True)
Dim str_OrderNumber As Control() = Me.Controls.Find("txb_" & str_DoorName & "OrderNumber", True)
Dim SecondArrayForPONumbers As Control() = Me.Controls.Find("str_SameTruckPO" & str_DoorName, True)
If str_DoorType(0).Text = "Outbound" Then
str_DoorType(0).Text = ""
str_Customer(0).Text = ""
str_OrderNumber(0).Text = ""
ElseIf SecondArrayForPONumbers(0).Text.Length > 0 Then
str_DoorType(0).Text = "Outbound"
str_OrderNumber(0).Text = Me.Controls("str_SameTruckPO" & str_DoorName).Text
End If
Any help is appreciated. If I'm not clear on what I'm asking or haven't given enough details, please let me know.
Edit: Added info based on comment, Added code, Changed Title
How long do you want this data to be stored? IE: longer than the life of the open application? If the application is closed is it alright if the data is lost? If not, you may want to consider writing this data to an external database.