I need to set some buttons for RunTime users.
I was created USysRibbon table, inserted XML and tested via Database options. All works fine.
But I need load Custom ribbon via VBA custom function. This function will be executed via AutoExec macro (after user login and user id as temp variable is set).
Please help me to create simple VBA to call LoadCustomUI function and get XML from table (in that table is ID, RibbonName and RibbonXML) and apply to user interface.
Thank you.
I assume that you have created your ribbon table like this : http://www.accessribbon.de/en/?Access_-_Ribbons:Load_Ribbons_Into_The_Database:..._Using_The_System_Table_USysRibbons
Let's say:
your AutoExec macro execute the function Start_App()
You have in your table a record with RibbonName="MyRibbon1"
Create a module with the following code
' This variable handle your ribbon name, so if you have several Ribbons in your table, you adapt this constant to match the current Ribbon
Public Const APP_RIBBON As String = "MyRibbon1"
Public Function Start_app()
On Error GoTo Err_Handler
LoadRibbons
' do anything else you need in the Start_app
Exit_Sub:
Exit Function
Err_Handler:
If Err.Number > 0 Then
MsgBox Err.DESCRIPTION, vbExclamation, "An error " & Err.Number & " occured !"
Debug.Print Err.Number
Resume Exit_Sub
End If
End Function
Private Function LoadRibbons()
On Error GoTo Error1
Dim RS As dao.Recordset
Set RS = CurrentDB.OpenRecordset("SELECT * FROM USysRibbon ")
Do Until RS.EOF
If RS("RibbonName").value = APP_RIBBON Then
' Ribbon found: Load it and exit
Application.LoadCustomUI APP_RIBBON, RS("RibbonXML").value
Exit Do
End If
RS.MoveNext
Loop
Error1_Exit:
On Error Resume Next
RS.Close
Set RS = Nothing
Exit Function
Error1:
Select Case Err
Case 32609
' Ribbon already loaded, do nothing and exit
Case Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.DESCRIPTION, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End Select
Resume Error1_Exit
End Function
Note that you have an additional thing to do: the first time you run the code, the Ribbon will not show. You have to go in the options / current database and in the combo box Ribbon Name: select the ribbon. If you have run the code once, your MyRibbon1 should appear in the combo box
In Access 2007 My Error Trapping is set on Break on Unhandled Errors
I want the code to stop at the line where an error occurs and exit functions instead of resuming to the next line of code. However it doesn't seem to be working for me. I purposely created an error at line 6 to see if it would exit the function after this line but it only prompts the error handler message and continues to resume to the next line after error occured.
Here is my code:
GoToBackend():
'Go to current linked backend database
Private Function GoToBackend()
On Error GoTo BackendErrorHandler
'To update BEPath requires two sets of proc.
'Delete Exisiting
RunQuery "DeleteBEEPath" 'Here is where I created error by miss spelling it
'Insert Into
RunQuery "InsertBEPath"
'Prompt alert
MsgBox "Front end tables succesfully linked. Access now needs to run the backend database to complete the linking process. Please ensure macros/vba are enabled if prompted.", 48
Hyperlink.GoHyperlink (Hyperlink.PrepHyperlink(GetBackendPath))
ExitFunction:
Exit Function 'Why won't this exit the function?
BackendErrorHandler:
Dim Msg As String
Msg = Err.Number & ": " & Err.Description
MsgBox Msg
Resume ExitFunction
End Function
RunQuery():
'Run a given query name
Private Function RunQuery(qName As String)
On Error GoTo RunQueryErrorHandler
DoCmd.SetWarnings False
DoCmd.OpenQuery qName
DoCmd.SetWarnings True
ExitFunction:
Exit Function
RunQueryErrorHandler:
Dim Msg As String
Msg = Err.Number & ": " & Err.Description
MsgBox Msg
Resume ExitFunction
End Function
The error itself happens in your RunQuery function so the error is handled there. In there you say to display the message for the error with Msg = Err.Number & ": " & Err.Description so therefore it pops up and the error is considered "Handled" and the original function continues to run.
Your line here:
RunQuery "DeleteBEEPath"
Doesn't care what your string is, in its eyes you have properly provided it a string to pass onto the function. Once it enters the function that is where the actual error occurs. I haven't tested this but I believe if you turn off the error handling in your second function then the error handling in GoToBackend should handle it in the way you want it to. So your second function would be something like this:
Private Function RunQuery(qName As String)
DoCmd.SetWarnings False
DoCmd.OpenQuery qName
DoCmd.SetWarnings True
End Function
Once again I haven't really been able to test this but this should get you on the right path or perhaps if someone with some more experience is around they could provide a better answer than I.
I would also recommend putting DoCmd.SetWarnings (True) in your error handling, that way if the error occurs after you set the to false they will get turned back on.
Edit: I figured I would throw in my newly conceptualized function. (Untested)
Public Function RunSQLNoWarnings(strSQLQuery As String) As Boolean
On Error GoTo Err_Handler
DoCmd.SetWarnings (False)
DoCmd.RunSQL (strSQLQuery)
DoCmd.SetWarnings (True)
RunSQLNoWarnings = True
Exit_Handler:
Exit Function
Err_Handler:
DoCmd.SetWarnings (True)
Call LogError(Err.Number, Err.Description, strMODULE_NAME & ".RunSQLNoWarnings on SQL Query: " & strSQLQuery)
RunSQLNoWarnings = False
Resume Exit_Handler
End Function
I have a form with a text box named Contract_Applying_for which is disabled on form load, but I want to have a button which allows me to edit the contents of the text box.
When I add a button I get presented with the Command Button Wizard, so I have created a Macro called ToggleEnableButton which has the instruction to
RunCode Function Name "=ToggleEnableButton()"
Then I have written the function
Function ToggleEnableButton()
If Me.Contract_Applying_for.Enabled = True Then
Me.Contract_Applying_for.Enabled = False
Else
Me.Contract_Applying_for.Enabled = True
End If
End Function
This seems to produce the error "Member already exists in an object module from which this object module derives."
The code for the ToggleEnableButton_Click is automatically created by the Command Button Wizard and is
Private Sub ToggleEnableButton_Click()
On Error GoTo Err_ToggleEnableButton_Click
Dim stDocName As String
stDocName = "ToggleEnableMacro"
DoCmd.RunMacro stDocName
Exit_ToggleEnableButton_Click:
Exit Sub
Err_ToggleEnableButton_Click:
MsgBox Err.Description
Resume Exit_ToggleEnableButton_Click
End Sub
Any suggestion of what I am doing wrong or a better way to approach this.
Seems like a very simple thing that I am trying to do, but quite a long winded approach.
As suggested by Peekay in the comments I have tried to use a checkbox instead, I wrote
Private Sub chbToggleEdit_Click()
If Me.chbToggleEdit.Value = False Then
Me.Contract_Applying_for.Enabled = False
Else
Me.Contract_Applying_for.Enabled = True
End If
End Sub
This gives the error: "A problem occurred while Microsoft Access was communication with the OLE server or ActiveX Control."
Can you not simply have:
Private Sub ToggleEnableButton_Click()
On Error GoTo Err_ToggleEnableButton_Click
ToggleEnableButton()
Exit_ToggleEnableButton_Click:
Exit Sub
Err_ToggleEnableButton_Click:
MsgBox Err.Description
Resume Exit_ToggleEnableButton_Click
End Sub
You can declare your function with the code behind your form.
Let me know if that works,
Ash
I am using David-W-Fenton's answer to this question to try to allow users to print a report when they click on a control, but I am getting the following error message:
runtime error 2448: you cannot assign a value to this object.
The line of code triggering the error is:
Me.txtPageTo.Value = numPages
Here is the full code of the OnLoad event handler for the form:
Private Sub Form_Load()
Dim varPrinter As Printer
Dim strRowsource As String
Dim strReport As String
If Len(Me.OpenArgs) > 0 Then
strReport = Me.OpenArgs
Me.Tag = strReport
For Each varPrinter In Application.Printers
strRowsource = strRowsource & "; " & varPrinter.DeviceName
Next varPrinter
Me!cmbPrinter.RowSource = Mid(strRowsource, 3)
' first check to see that the report is still open
If (1 = SysCmd(acSysCmdGetObjectState, acReport, strReport)) Then
With Reports(strReport).Printer
Me!cmbPrinter = .DeviceName
Me!optLayout = .Orientation
End With
Dim numPages As String
numPages = Reports(strReport).Pages
Debug.Print "numPages = " & numPages
TypeName(Me.txtPageTo) 'added this line as a test after
Me.txtPageTo.Value = numPages
End If
End If
End Sub
numPages prints out to equal 0 just before the error is thrown, even though the report should have at least one page. Also, the error does not get thrown when the form is already open. The error only gets thrown when the form has to be opened. (Probably because the offending code is in the onload event.)
When I added TypeName(Me.txtPageTo) , it triggered runtime error 2424: The expression you entered has a field, control, or property name that mydatabasename cant find.
I think the problem is that I need to set the control source for txtPageFrom and txtPageTo. But how do I do that? This form will only be loaded by a vba method that is trying to print a report, so the values for txtPageFrom and txtPageTo will come from the calling method, not from some underlying data table. (there is no underlying data table for this dialog form.)
cmbPrinter and optLayout seem to be populating correctly using the code above.
Can anyone show me how to get past the error messages so that the form loads properly?
CORRECT, COMPLETE ANSWER:
The answer to this problem was to greatly simplify the code. The code in the link at the top of this posting is WAY TOO COMPLEX, and tries to reinvent things that are already done well by the tools built into Access and VBA. I was able to print reports without any of the complicated solutions by simply using the following code in the on-click event of a control on a form associated with the report:
Private Sub txtPrintReport_Click()
On Error GoTo Error_Handler
Dim commNum As Long
commNum = Me.CommunicationNumber
Dim strReport As String
Dim strVarName As String
strReport = "rptCommunicationFormForPrinting"
strVarName = "CommunicationNumber"
DoCmd.OpenReport strReport, acViewPreview, , strVarName & " = " & commNum, acWindowNormal, acHidden
DoCmd.RunCommand acCmdPrint
DoCmd.Close acReport, strReport
Exit_Point:
Exit Sub
Error_Handler: 'this handles the case where user clicks cancel button
If Err.Number <> 2501 Then
MsgBox Err.Description, _
vbExclamation, "Error " & Err.Number
End If
DoCmd.Close acReport, strReport
End Sub
That is all the code that was required. Much less than the link at the start of this question. And also much less than the answer below. I am marking John Bingham's answer as the accepted answer because he clearly worked a lot on this, and I am very grateful for that. But I ended up solving the problem with A LOT LESS CODE. My solution does not require the custom dialog form because it uses the Windows print dialog form. As such, the on load event code in my posting (taken from the link above), is not necessary.
The code posted cannot work, because when a form is opened as a dialog:
DoCmd.OpenForm "dlgPrinter", , , , , acDialog, strReport
no other logic after this line is executed until the form has been closed, at which point control returns to the next line after this one, and logic continues on - except of course you can no longer reference anything in that form, because it is now closed.
Ok, now there is a question, where is the button the user clicks to print a report?
What I'm thinking is to split the logic in PrintReport into two methods, one that launches it, and tells the form to configure itself (doing the stuff suggested in the comment), but the rest of PrintReport then needs to happen after the user clicks OK (or Cancel);
So if I assume that you've got a form which can launch one or more reports, and the button is on this form, what I would suggest is this:
In the click event for that button - no changes to what you've got.
In that buttons form, add this:
Public Sub DialogAccept()
With Forms!dlgPrinter
If .Tag <> "Cancel" Then
Set Reports(strReport).Printer = Application.Printers((!cmbPrinter))
Reports(strReport).Printer.Orientation = !optLayout
Application.Echo False
DoCmd.SelectObject acReport, strReport
DoCmd.PrintOut acPages, !txtPageFrom, !txtPageTo
PrintReport = True
End If
End With
DoCmd.Close acForm, "dlgPrinter"
DoCmd.Close acReport, strReport
Application.Echo True
End Sub
Change PrintReport to:
Public Function PrintReport(strReport As String, strVarName As String, numVal As Long) As Boolean
' open report in PREVIEW mode but HIDDEN
DoCmd.OpenReport strReport, acViewPreview, , strVarName & " = " & numVal, acHidden
'DoCmd.OpenReport strReport, acViewPreview, , , acHidden
' open the dialog form to let the user choose printing options
DoCmd.OpenForm "dlgPrinter", , , , , , strReport
Forms!dlgPrinter.Configure
End Function
In the OK/Cancel button click events on dlgPrinter put (after existing code, but removing any instances of "Docmd.close"):
Forms!Calling_Form_Name.DialogAccept
This then calls that method, to do the stuff that is meant to happen after the user says "I'm done with the dialog".
Finally add the configure method to dlgPrinter:
Public Sub Configure()
With Reports(Me.Tag).Printer
Me!cmbPrinter = .DeviceName
Me!optLayout = .Orientation
End With
Dim numPages As String
numPages = Reports(Me.Tag).Pages
Debug.Print "numPages = " & numPages
TypeName(Me.txtPageTo) 'added this line as a test after
Me.txtPageTo.Value = numPages
End Sub
And remove this code section from Form_Load.
Hoep this helps.
Lastly, if the form on which the button launching dlgPrinter can vary, change this line:
DoCmd.OpenForm "dlgPrinter", , , , , acDialog, strReport
to:
DoCmd.OpenForm "dlgPrinter", , , , , acDialog, strReport & ";" & me.Name
In form_load of dlgPrinter, break up me.Openargs using left() & mid() with instr(), and save me.Name into the tag of something on the form (which you're not already using the tag of).
In the OK/Cancel button click events, change the code above to:
Forms(Object.Tag).DialogAccept
I'm seeing an error code like this in my Access 2000 VBA:
-2147352567-Record in '[SomeTable]' was deleted by another user.
So, 2 questions:
1) How do I handle/avoid an error code like this?
2) Can anyone explain why I'm getting an error code that doesn't seem to exist in MS documentation? And is there some way to decipher this code? Is it a combination of several codes? Any guidance on this topic would be appreciated.
Public Sub Form_Open(Cancel As Integer)
' Check for unposted record / regardless of Date / Shift
' If there is an unposeted record goto it
Dim lCheck
Dim sPress As String
On Error GoTo Form_Open_Err
GotoRecord:
If bPressConsumptionOpenRan = True Then
lCheck = DLookup("PressConsumptionID", "spI_GetUnPostedRecord")
If Not IsNothing(lCheck) Then
Me.txtPressConsumptionID.SetFocus
DoCmd.FindRecord lCheck
Else
DoCmd.SetWarnings False
DoCmd.OpenQuery ("spI_InsertNewPressConsumption")
Me.Requery
DoCmd.SetWarnings True
End If
End If
Form_Open_Exit:
Exit Sub
Form_Open_Err:
sErrMsg = Err.Number & "-" & Err.Description
MsgBox sErrMsg, vbCritical + vbOKOnly + vbInformation, "Program Error"
So I just commented out the
On Error GoTo
lines in Form_Open(), Form_Load(), and Form_Activate(), and still no debugger call. This error is shown when the db is opened, so I have no idea where else the error could be in the code.
And here is the code for IsNothing:
Public Function IsNothing(vCheck As Variant) As Boolean
On Error GoTo IsNothing_Err
If IsNull(vCheck) Then IsNothing = True: Exit Function
If IsEmpty(vCheck) Then IsNothing = True: Exit Function
If Trim(vCheck) = "" Then IsNothing = True: Exit Function
IsNothing_Err:
IsNothing = False
End Function
Now I'm getting a similar error in Form_Current():
Private Sub Form_Current()
Dim sUser As String
On Error GoTo Form_Current_Err
If IsNothing(Me.dtpUsageDate) Then
Me.dtpUsageDate = Date 'This line throws error.
End If
...Ommitted to save space. Not relevant...
Form_Current_Err:
sErrMsg = Err.Number & "-" & Err.Description
MsgBox sErrMsg, vbCritical + vbOKOnly + vbInformation, "Program Error"
Resume Form_Current_Log
Form_Current_Log:
On Error Resume Next
Call LogError(sErrMsg, "PressConsumptions_Form_Current")
GoTo Form_Current_Exit
End Sub
Error Message:
-2417352567-There is no object in this control.
Is this message related to the other one we've been seeing? Any thoughts on correcting?
The error number and message suggest to me that this is a problem from outside of Access. The fact that you're executing a saved query that has a name suggesting that it runs an SPROC on a database server suggests to me that the back end is SQL Server or some other back end.
It's a very common error in Access when you don't have both a primary key and a timestamp field in your back end table. It's caused by the fact that Access can't tell exactly which record is involved and can't refresh the display appropriately. Having a PK and a timestamp field usually gets rid of the problem.
But it may be caused by something else, of course.