I need a quick Hint. Please.....

D

doran_doran

Registered User.
Local time
Today, 11:16
Joined
Aug 15, 2002
Messages
349
Hi, I am using following code when the form opens so I can set the my combo box row source according to user access. Any idea, why it's not working.

Thanks

===== code starts here =====

Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open

If User.AccessID = 1 Then
Me.cboAdmin.Enabled = True
Me.cboAdmin = Me.cboAdmin2
Forms!frmRptQRIndividual!cboAdmin.RowSourceType = "Table/Query"
Forms!frmRptQRIndividual!cboAdmin.RowSource = "qryAdmin"
Me.cboAdmin.Locked = False

ElseIf User.AccessID = 2 Then
Me.cboAdmin.Enabled = True
Me.cboAdmin = Me.cboAdmin2
Forms!frmRptQRIndividual!cboAdmin.RowSourceType = "Table/Query"
Forms!frmRptQRIndividual!cboAdmin.RowSource = "qryAdmin"
Me.cboAdmin.Locked = False

ElseIf User.AccessID = 3 Then
Me.cboAdmin.Enabled = True
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Locked = False
Forms!frmRptQRIndividual!cboAdmin.RowSourceType = "Query"
Forms!frmRptQRIndividual!cboAdmin.RowSource = "qryAdminBYTL"
Else
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Enabled = False
Me.cboAdmin.Locked = True

End If

Exit_Form_Open:
Exit Sub

Err_Form_Open:
MsgBox Err.Description
Me.Visible = True
Resume Exit_Form_Open
End Sub
 
On Load did not work...

Hi Colin,

Thanks for your suggession. I tried it on Load and it did not work.

Any other ideas ?
 
I use an OptionBox with 2 options to change a ComboBox recordset. I use this code

Code: 
If Me.SelectDrugfile = 2 Then

msgbox "The non-PIMS items are now included in the main list", vbInformation, "Note"

Me.ItemSelect.RowSource = "qryPIMSDrugfileForComboBox"
Else
Me.ItemSelect.RowSource = "qryPIMSDrugfile2ForComboBox"
End If

and it works fine.

Instead of the Forms!etc!etc! try using Me. instead

Col
 
It appears that you are trying to set the combo box of a different form. Is this correct?
Why not set the combo box properties on Form_Open within the form that needs the change?
I have done this before and it worked.
 
what does this bit mean?
Code: 
Me.cboAdmin = Me.cboAdmin2

is there a value in either of these when the form opens?

Col
 
Thanks everyone for helping me. I took 2 steps to do this.

step1: form open method to hide and show two diff combo box.
step2: change my code little bit.

step 1 code
=========
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open

If User.AccessID = 1 Then
Me.cboAdmin.Visible = True
Me.cboAdminbyTL.Visible = False
Me.cboAdmin.Enabled = True
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Locked = False

ElseIf User.AccessID = 2 Then
Me.cboAdmin.Visible = True
Me.cboAdminbyTL.Visible = False
Me.cboAdmin.Enabled = True
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Locked = False

ElseIf User.AccessID = 3 Then
Me.cboAdmin.Visible = False
Me.cboAdminbyTL.Visible = True
Me.Label_CS_Admin_by_TL.Visible = True
Me.cboAdminbyTL = Me.cboAdmin2

Else
Me.cboAdmin.Visible = True
Me.cboAdminbyTL.Visible = False
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Enabled = False
Me.cboAdmin.Locked = True

End If

Exit_Form_Open:
Exit Sub

Err_Form_Open:
MsgBox Err.Description
Me.Visible = True
Resume Exit_Form_Open
End Sub



step 2 code
=========
Option Compare Database
Private Sub cmdExport_Click()
If ValidateRptData() = True Then
ExportData2Excel
End If
End Sub
Private Sub cmdGetDateEnd_Click()
DateCheck Me!txtEndDate
If Me!txtEndDate < Me!txtStartDate Then
MsgBox "End date must come after start date."
Me!txtEndDate = ""
Me!txtEndDate.SetFocus
End If
End Sub
Private Sub cmdGetDateStart_Click()
DateCheck Me!txtStartDate
End Sub
Sub DateCheck(ctlDate As TextBox)
Dim datepassed As Variant
datepassed = ctlDate
ctlDate = GetDate(datepassed)
End Sub
Private Sub cmdPreview_Click()
If ValidateRptData() = True Then
Search4Data
End If
End Sub
Private Sub cmdPrint_Click()
PrintData
End Sub
Function ValidateRptData()
ValidateRptData = True

If User.AccessID = 3 Then
If IsNull(Me!cboAdminbyTL) Then
MsgBox "Please select CS Admin from the dropdown."
Me!cboAdmin.SetFocus
ValidateRptData = False
ElseIf IsNull(Me!txtStartDate) Then
MsgBox "Enter start date."
Me!txtStartDate.SetFocus
ValidateRptData = False
ElseIf IsNull(Me!txtEndDate) Then
MsgBox "Enter end date."
Me!txtEndDate.SetFocus
ValidateRptData = False
End If
Else
If IsNull(Me!cboAdmin) Then
MsgBox "Please select CS Admin from the dropdown."
Me!cboAdmin.SetFocus
ValidateRptData = False
ElseIf IsNull(Me!txtStartDate) Then
MsgBox "Enter start date."
Me!txtStartDate.SetFocus
ValidateRptData = False
ElseIf IsNull(Me!txtEndDate) Then
MsgBox "Enter end date."
Me!txtEndDate.SetFocus
ValidateRptData = False
End If
End If

If Me!txtStartDate > Me!txtEndDate Then
MsgBox "Please enter an End Date that is later than the Start Date"
Me!txtStartDate.SetFocus
ValidateRptData = False
End If

End Function
Function PrintData()
On Error GoTo Err_PrintInvoice_Click

Dim strDocName As String
Dim strDocName2 As String
'Dim prtNew As Printer

strDocName = "rptQRIndividual"
strDocName2 = "rptQRIndividualByTL"

Query4Data

If User.AccessID = 3 Then
DoCmd.OpenReport strDocName2, acViewNormal
Else
DoCmd.OpenReport strDocName, acViewNormal
End If

Exit_PrintInvoice_Click:
Exit Function

Err_PrintInvoice_Click:
' If action was cancelled by the user, don't display an error message.
Const conErrDoCmdCancelled = 2501
If (Err = conErrDoCmdCancelled) Then
Resume Exit_PrintInvoice_Click
Else
MsgBox Err.Description
Resume Exit_PrintInvoice_Click
End If

End Function
Function Query4Data()

Dim strSQL As String
Dim qdfApp As QueryDef

DoCmd.SetWarnings False

Set qdfApp = currentdb.QueryDefs("qryRptQRIndividual")

If User.AccessID = 3 Then
strSQL$ = "SELECT * FROM qryRptQRIndividualbytl WHERE ((qryRptQRIndividualbytl.PYE Between # " & Me!txtStartDate & " # AND # " & Me!txtEndDate & "# )" & " AND qryRptQRIndividual.Primary_Administrator = " & Quotes$ & Me!cboAdminbyTL & Quotes$
Else
strSQL$ = "SELECT * FROM qryRptQRIndividual WHERE ((qryRptQRIndividual.PYE Between # " & Me!txtStartDate & " # AND # " & Me!txtEndDate & "# )" & " AND qryRptQRIndividual.Primary_Administrator = " & Quotes$ & Me!cboAdmin & Quotes$
End If

qdfApp.close
DoCmd.SetWarnings True

End Function
Function ExportData2Excel()
On Error GoTo Err_DoExportData

Dim db As DAO.Database
Dim stDocName As String, strFilter As String, strSaveFileName As String
Dim SQL$, Qd As QueryDef, Quotes$
Quotes$ = """"

Set db = currentdb()

Query4Data

'Ask for SaveFileName
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave( _
OpenFile:=False, _
Filter:=strFilter, _
flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "qryRptQRIndividualExport", strSaveFileName, True

MsgBox "The data has been sucessfully exported", vbDefaultButton1, "Data Export"

Exit Function

Err_DoExportData:
MsgBox Err.Description

End Function
Function Search4Data()
On Error GoTo Err_BooleanSearch

Dim SQL$
Dim db As DAO.Database, Qd As QueryDef, Quotes$
Quotes$ = """"

Query4Data

If User.AccessID = 3 Then
DoCmd.OpenReport "rptQRIndividualbyTL", acViewPreview
Else
DoCmd.OpenReport "rptQRIndividual", acViewPreview
End If

Exit Function

Err_BooleanSearch:
MsgBox Err.Description

End Function
Private Sub cmdRptMenu_Click()
On Error GoTo Err_cmdRptMenu_Click

Dim stDocName As String
Dim stLinkCriteria As String
DoCmd.close

stDocName = "frmReportMenu"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_cmdRptMenu_Click:
Exit Sub

Err_cmdRptMenu_Click:
MsgBox Err.Description
Resume Exit_cmdRptMenu_Click


End Sub
Private Sub Print_Click()
On Error GoTo Err_Print_Click
If ValidateRptData() = True Then
Dim stDocName As String
Dim stDocName2 As String

Query4Data

stDocName = "rptQRIndividual"
stDocName2 = "rptQRIndividualbyTL"

If User.AccessID = 3 Then
DoCmd.OpenReport stDocName2, acNormal
Else
DoCmd.OpenReport stDocName, acNormal
End If

Exit_Print_Click:
Exit Sub

Err_Print_Click:
MsgBox Err.Description
Resume Exit_Print_Click
End If
End Sub
Private Sub Close_Click()
On Error GoTo Err_Close_Click

DoCmd.close

Exit_Close_Click:
Exit Sub

Err_Close_Click:
MsgBox Err.Description
Resume Exit_Close_Click

End Sub
Private Sub cmdSnap_Click()
If ValidateRptData() = True Then
ExportData2Snap
End If
End Sub
Private Sub Form_Close()
DoCmd.close acForm, "frmUserLogonQR4"
End Sub
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open

If User.AccessID = 1 Then
Me.cboAdmin.Visible = True
Me.cboAdminbyTL.Visible = False
Me.cboAdmin.Enabled = True
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Locked = False

ElseIf User.AccessID = 2 Then
Me.cboAdmin.Visible = True
Me.cboAdminbyTL.Visible = False
Me.cboAdmin.Enabled = True
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Locked = False

ElseIf User.AccessID = 3 Then
Me.cboAdmin.Visible = False
Me.cboAdminbyTL.Visible = True
Me.Label_CS_Admin_by_TL.Visible = True
Me.cboAdminbyTL = Me.cboAdmin2

Else
Me.cboAdmin.Visible = True
Me.cboAdminbyTL.Visible = False
Me.cboAdmin = Me.cboAdmin2
Me.cboAdmin.Enabled = False
Me.cboAdmin.Locked = True

End If

Exit_Form_Open:
Exit Sub

Err_Form_Open:
MsgBox Err.Description
Me.Visible = True
Resume Exit_Form_Open
End Sub
Private Sub switchboard_Click()
On Error GoTo Err_switchboard_Click

Dim stDocName As String
Dim stLinkCriteria As String
DoCmd.close

stDocName = "switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_switchboard_Click:
Exit Sub

Err_switchboard_Click:
MsgBox Err.Description
Resume Exit_switchboard_Click

End Sub
Function ExportData2Snap()
On Error GoTo Err_DoExportData

Dim db As DAO.Database
Dim stDocName As String, strFilter As String, strSaveFileName As String
Dim SQL$, Qd As QueryDef, Quotes$
Quotes$ = """"

Set db = currentdb()

Query4Data

strFilter = ahtAddFilterItem(strFilter, "Snapshot Format (*.snp)", "*.snp")

If User.AccessID = 3 Then
DoCmd.OutputTo acOutputReport, "rptQRIndividualbytl", "SnapshotFormat(*.snp)", ""
MsgBox "The Snapshot has been sucessfully exported", vbDefaultButton1, "Data Export"
Else
DoCmd.OutputTo acOutputReport, "rptQRIndividual", "SnapshotFormat(*.snp)", ""
MsgBox "The Snapshot has been sucessfully exported", vbDefaultButton1, "Data Export"
End If

Exit Function

Err_DoExportData:
MsgBox Err.Description

End Function
 
For long pieces of VBA code, please use the [CODE] [/CODE] tags provided by the forum.

Also, you'll find your code a little easier to read if you use a SELECT CASE structure instead of the IF ELSEIF ELSE ENDIF structure.
 
You must log in or register to reply here.

Similar threads

D
Solved Encapsulate Function In A Class For Command Bar
Replies
16
Views
1,542
MajP
MajP
Mike Krailo
Solved Need help with before update code logic?
Replies
10
Views
1,152
Mike Krailo
Mike Krailo
D
Solved New detail records being added despite disabled button in master form
2
Replies
27
Views
866
GPGeorge
GPGeorge
K
Self-Healing Ribbon Pointer
Replies
0
Views
790
KevinBaker
K
essaytee
Why messagebox appears then closes on successful run of DoCmd.OutputTo....pdf
Replies
5
Views
819
Mark_
M

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom