I have a main form called (frmcarSearch) that displays table data called (tblCar).
The form contains three drop-down menu (cmbCar, cmbType, cmbGroup) that allow user to filter data and display them in a sub-form called (frmCarSub)
and there are three buttons to save the filtered data btnPrint, btnPDF, btnExcel.
The question is: How to write a code for each button so that the report displays (or save) the data in the sub-form according to the choice from each drop-down menu?
The code for each combo box:
Private Sub cmbCar_AfterUpdate()
Me.cmbGroup.Value = ""
Me.cmbType.Value = ""
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = "[CarNum]= '" & [cmbCar] & "'"
Me.frmCarSub.Form.FilterOn = True
End Sub
Private Sub cmbType_AfterUpdate()
Me.cmbGroup.Value = ""
Me.cmbCar.Value = ""
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = "[TypeName]='" & [cmbType] & "'"
Me.frmCarSub.Form.FilterOn = True
End Sub
Private Sub cmbGroup_AfterUpdate()
Me.cmbCar.Value = ""
Me.cmbType.Value = ""
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = "[CarGroupName]= '" & [cmbGroup] & "'"
Me.frmCarSub.Form.FilterOn = True
End Sub
I used this code for btnPrint button
Private Sub btnPrint_Click()
If IsNull([cmbCar]) Then
DoCmd.OpenReport "rptCar", acViewPreview
Else
DoCmd.OpenReport "rptCar", acViewPreview, , "[CarNum]='" & [cmbCar] & "'"
End If
End Sub
But the problem with this code is that I have to use three buttons for the three menus and this is illogical.
Thank you.
You could define a function such as the following with the module for your form:
Function FilterString() As String
If Not IsNull(cmbCar) Then FilterString = " AND [CarNum]= '" & cmbCar & "'"
If Not IsNull(cmbType) Then FilterString = FilterString & " AND [TypeName]= '" & cmbType & "'"
If Not IsNull(cmbGroup) Then FilterString = FilterString & " AND [CarGroupName]= '" & cmbGroup & "'"
FilterString = Mid(FilterString, 6)
End Function
Then, define another function such as:
Function SetFilter()
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = FilterString
Me.frmCarSub.Form.FilterOn = True
End Function
Then, the event handlers for each of your comboboxes become:
Private Sub cmbCar_AfterUpdate()
SetFilter
End Sub
Private Sub cmbType_AfterUpdate()
SetFilter
End Sub
Private Sub cmbGroup_AfterUpdate()
SetFilter
End Sub
Finally, the Print button event handler can become:
Private Sub btnPrint_Click()
If FilterString = vbNullString Then
DoCmd.OpenReport "rptCar", acViewPreview
Else
DoCmd.OpenReport "rptCar", acViewPreview, , FilterString
End If
End Sub
And the user also has the ability to filter by more than one field.
Related
I am trying to pull in column data from a table into a timer in VBA. In my table I have IntervalSeconds as a number. I'm trying to query the number of seconds to determine how long to set my counter for.
Dim timeRemaining As Long (Form Variable) - used in multiple functionss
Private Sub Form_Open(Cancel As Integer)
Dim strSQL As String
Me.Visible = False
strSQL = "SELECT AccessControl.IntervalSeconds FROM AccessControl WHERE AccessControl.DatabaseName = '" & CurrentDb.Name & "'"
timeRemaining = CLng(strSQL)
DoCmd.OpenForm ("frmForceLogout")
End Sub
Every time I run the form I get a Type Mismatch error when I hit the timeRemaining = cLng(strSQL) line. Am I missing something?
You can use DLookup for such simple tasks:
Private Sub Form_Open(Cancel As Integer)
Dim Criteria As String
Me.Visible = False
Criteria = "DatabaseName = '" & CurrentDb.Name & "'"
timeRemaining = DLookup("IntervalSeconds", "AccessControl", Criteria)
DoCmd.OpenForm ("frmForceLogout")
End Sub
I have got this code below that restricts users to leave an empty field in a form. Now I want to use this in all of my forms. I've tried to use in Public Subroutine using a module. But it doesn't work.
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim msg As String, Style As Integer, Title As String
Dim nl As String, ctl As Control
nl = vbNewLine & vbNewLine
For Each ctl In Me.Controls
If ctl.ControlType = acTextBox Then
If ctl.Tag = "*" And Trim(ctl & "") = "" Then
msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
"You can't save this record until this data is provided!" & nl & _
"Enter the data and try again . . . "
Style = vbCritical + vbOKOnly
Title = "Required Data..."
MsgBox msg, Style, Title
ctl.SetFocus
Cancel = True
Exit For
End If
End If
Next
End Sub
I just want to use this in all of my forms. How do I accomplish this?
Good question, and good idea.
So, keep in mind that "me" is just the current form you are working with.
So, create a plane jane standard code module. And drop in your function like this with a "few" changes.
Public Function CheckRequired(MyMe As Form) As Boolean
Dim msg As String
Dim Style As Integer
Dim Title As String
Dim nl As String
Dim ctl As Control
nl = vbCrLf ' crlf gives you one line
CheckRequired = False ' assume everything ok
For Each ctl In MyMe.Controls
If ctl.ControlType = acTextBox Then
If ctl.Tag = "*" And Trim(ctl & "") = "" Then
msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
"You can't save this record until this data is provided!" & nl & _
"Enter the data and try again . . . "
Style = vbCritical + vbOKOnly
Title = "Required Data..."
MsgBox msg, Style, Title
ctl.SetFocus
CheckRequired = True
Exit Function
End If
End If
Next
End Function
Now, in the forms event (which has that cancel), then you do this:
Private Sub Form_BeforeUpdate(Cancel As Integer)
Cancel = CheckRequired(Me)
End Sub
As #June7 mentioned, Me is only valid behind forms and reports. It is shorthand alias for the form/report name/object. To achieve what you are looking for, you can try this concept. Create the global routine like below :
Public Function Validate_BeforeUpdate(frm As Form) As Integer
Dim msg As String, Style As Integer, Title As String
Dim nl As String, ctl As Control
nl = vbNewLine & vbNewLine
For Each ctl In frm.Controls
'''' your other code
Validate_BeforeUpdate = 1
Exit For
Next
End Sub
And to use this from your other forms, do it like below :
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Validate_BeforeUpdate(Me) = 1 Then
Cancel = True
End If
End Sub
This is not a tested code, if you follow this idea, you should be okay to have what you are trying to do.
I try to set a filter of an continuous form in access vba. This is the code I use:
Private Sub Form_Open(Cancel As Integer)
Dim filter As String
filter = "1 = 0" ' "1=0" is just for testing purpurses
Me.filter = filter
Me.FilterOn = True
Debug.Print Me.FilterOn & "; " & Me.filter
end sub
The output is:
False; 1 = 0
and the filter is not used.
Why does this not work? And is there a way to set and activate the filter before the form is shown?
I found out that the reason is. I use a framework where I set the recordsource later. While there is no recordsource, "Me.FilterOn = True" simply does not work. The following code does work:
Private Sub Form_Open(Cancel As Integer)
Me.RecordSource = "select * from MyTable"
Dim filter As String
filter = "1 = 0" ' "1=0" is just for testing purpurses
Me.filter = filter
Me.FilterOn = True
Debug.Print Me.FilterOn & "; " & Me.filter
end sub
and the output is:
True; 1 = 0
I would like to Filter my sub form based on my Combo box filter. I'm getting code error. I need help with this.
After Update I have written one event:
Private Sub cboSelected_AfterUpdate()
Dim MyName As String
MyName = " select * from [ITP_Checklist Log] where ([ITP_Checklist Log].[Name] = " & Me.cboSelected & " )"
Me.ITP_Checklist_Log_subform.Form.RecordSource = MyName
Me.ITP_Checklist_Log_subform.Form.Requery
End Sub
Error:
Run-time error '3464'
Data Type Mismatch in Criteria expression.
Use quotes for string values - and Requery is only needed if you don't change the recordsource:
Private Sub cboSelected_AfterUpdate()
Dim MyName As String
MyName = "select * from [ITP_Checklist Log] where ([ITP_Checklist Log].[Name] = '" & Me!cboSelected.Value & "')"
Debug.Print MyName
If Me!ITP_Checklist_Log_subform.Form.RecordSource = MyName Then
Me!ITP_Checklist_Log_subform.Form.Requery
Else
Me!ITP_Checklist_Log_subform.Form.RecordSource = MyName
End If
End Sub
Trying to get this code to work so that it will update my SQLite database. Keep getting an error saying that an end of statement is expected error BC30205. I cannot see what i am missing! This is my first ever attempt at an update statement in SQL so i may have missed something obvious! I have marked the line of code i am having the error with with an arrow!
Public Partial Class Change_Password
Public Sub New()
' The Me.InitializeComponent call is required for Windows Forms designer support.
Me.InitializeComponent()
'
' TODO : Add constructor code after InitializeComponents
'
End Sub
Dim SQLconnect As New System.Data.SQLite.SQLiteConnection()
Dim SQLcommand As System.Data.SQLite.SQLiteCommand
Dim SQLreader As System.Data.SQLite.SQLiteDataReader
Dim Password1 As String = ""
Dim Password2 As String = ""
Public Class Password
Public shared usernamechange As String = ""
End Class
Sub Cmd_NextClick(sender As Object, e As EventArgs)
If Trim(txt_Password_Box.Text) = "" Then
MsgBox("Please enter a password")
Else
Password1 = txt_Password_Box.Text
txt_Password_Box.Text = ""
txt_Password_Box.Focus
lbl_Instruction.Text = "Please re-enter the exact same password!"
cmd_Submit.Visible = True
cmd_Next.Visible = False
Me.AcceptButton = cmd_Submit
End If
End Sub
Sub Change_PasswordLoad(sender As Object, e As EventArgs)
cmd_Submit.Visible = False
Me.AcceptButton = cmd_Next
SQLconnect.ConnectionString = "Data Source=KCD.s3db;"
SQLconnect.Open()
End Sub
Sub Cmd_SubmitClick(sender As Object, e As EventArgs)
If Trim(txt_Password_Box.Text) = "" Then
MsgBox("Please enter the password again")
Exit Sub
Else
Password2 = txt_Password_Box.Text
txt_Password_Box.Text = ""
End If
If Password1 = Password2 Then
SQLcommand = SQLconnect.CreateCommand
------> SQLcommand.CommandText = "UPDATE Staff SET Password = '" & password1 & "' WHERE '" Username = "' & password.usernamechange & '"""
SQLcommand.Dispose()
MsgBox("Your password has been changed",vbInformation,"Password Changed")
Me.Close
Else
MsgBox("Passwords do not match. Please try again.")
txt_Password_Box.Focus
cmd_Submit.Visible = False
cmd_Next.Visible = True
Password1 = ""
Password2 = ""
lbl_Instruction.Text = "Please enter a new password!"
Me.AcceptButton = cmd_Next
End If
End Sub
End Class
Hope someone can help me! Thanks
This line doesn't seem right. Change
SQLcommand.CommandText = "UPDATE Staff SET Password = '" & password1 & "' WHERE '" Username = "' & password.usernamechange & '"""
to
SQLcommand.CommandText = "UPDATE Staff SET Password = '" & password1 & "' WHERE Username = '" & password.usernamechange & "'"
BTW, concatenating strings like that leads to being vulnerable to SQL Injection.