barbados2010
Registered User.
- Local time
- Yesterday, 17:37
- Joined
- Sep 7, 2012
- Messages
- 16
I need to add extra buttons to the code I already have for my ribbon. Do I need to change more than the code in UsysRibbonsor do I have to make changes to BasRibbonCallbacks also? I need to create maybe 3 extra buttons. Current code below (I had to alter the microsoft address to be able to post here)
UsysRibbons
UsysRibbons
Code:
RibbonXML
"<customUI xmlns=""h t t p://schemasdotmicrosoftdotcom/office/2006/01/customui"" onLoad=""onRibbonLoad"">
<ribbon startFromScratch=""true"">
<tabs>
<tab id=""tabHome"" label=""Home"">
<group id=""grpAccounting"" label=""Accounting"" visible=""true"">
<button id=""AccountingButton"" label=""Accounting"" imageMso=""CreateReport"" size=""large"" onAction=""OnActionButton"" />
</group>
<group id=""grpBuilding"" label=""Buildings"" visible=""true"">
<button id=""BuildingButton"" label=""Buildings"" imageMso=""BlogHomePage"" size=""large"" onAction=""OnActionButton"" />
</group>
<group id=""grpUnit"" label=""Units"" visible=""true"">
<button id=""UnitButton"" label=""Units"" imageMso=""OpenStartPage"" size=""large"" onAction=""OnActionButton"" />
</group>
<group id=""grpTenant"" label=""Tenants"" visible=""true"">
<button id=""TenantButton"" label=""Tenants"" imageMso=""AccessTableContacts"" size=""large"" onAction=""OnActionButton"" />
</group>
<group id=""grpIssue"" label=""Issues"" visible=""true"">
<button id=""IssueButton"" label=""Issues"" imageMso=""MailMergeAddressBlockInsert"" size=""large"" onAction=""OnActionButton"" />
</group>
<group id=""grpOwners"" label=""Owners"" visible=""true"">
<button id=""OwnersButton"" label=""Owners"" imageMso=""MeetingsWorkspace"" size=""large"" onAction=""OnActionButton"" />
</group>
<group id=""grpAdmin"" label=""Options"" visible=""true"">
<button id=""OptionsButton"" label=""Setup/Options"" imageMso=""OmsAccountSetup"" size=""normal"" onAction=""OnActionButton"" />
<labelControl id=""DateLabel"" getLabel=""getLabel"" />
</group>
<group id=""grpInfo"" label=""Info"">
<button id=""InfoButton"" size=""large"" label=""Info"" imageMso=""Info"" onAction=""OnActionButton""/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>"
Code:
Option Compare Database
Option Explicit
Public gobjRibbon As IRibbonUI
Public Sub OnRibbonLoad(ribbon As IRibbonUI)
'Callbackname in XML File "onLoad"
If IsDebugMode = 0 Then On Error GoTo OnRibbonLoad_Error
Set gobjRibbon = ribbon
OnRibbonLoad_Exit:
Exit Sub
OnRibbonLoad_Error:
Call ErrorLog(Err.Description, Err.Number, "basRibbonCallback", Erl, "OnRibbonLoad")
Resume OnRibbonLoad_Exit
End Sub
Public Sub OnActionButton(control As IRibbonControl)
'Callbackname in XML File "onAction"
On Error Resume Next
Dim strPassword As String
Select Case control.ID
Case "AccountingButton"
Call OpenForm("frmAccountingList", 1)
Case "BuildingButton"
Call OpenForm("frmBuildingList", 1)
Case "UnitButton"
Call OpenForm("frmUnitList", 1)
Case "IssueButton"
Call OpenForm("frmIssueList", 1)
Case "TenantButton"
Call OpenForm("frmTenantList", 1)
Case "OwnersButton"
Call OpenForm("frmTenantList", 1)
Case "EmployeeButton"
Call OpenForm("frmTenantListCopy", 1)
Case "OptionsButton"
strPassword = Nz(DLookup("SetupOptionsPassword", "tblPreference", "PreferenceID = 1"), "")
If (strPassword = "") Then
DoCmd.OpenForm "frmOptions"
ElseIf (InputBox("Enter Security Password:", "Security") = strPassword) Then
DoCmd.OpenForm "frmOptions"
End If
Case "InfoButton"
DoCmd.OpenForm "frmHelpAbout"
End Select
End Sub
Public Sub GetLabel(control As IRibbonControl, ByRef label)
'Callbackname in XML File "getLabel"
If IsDebugMode = 0 Then On Error GoTo GetLabel_Error
Select Case control.ID
Case "DateLabel"
label = Format(Now(), "dddd, mmm d, yyyy")
End Select
GetLabel_Exit:
Exit Sub
GetLabel_Error:
Call ErrorLog(Err.Description, Err.Number, "basRibbonCallback", Erl, "GetLabel")
Resume GetLabel_Exit
End Sub
Public Function MySend()
'This is used for the report ribbon to send a pdf of the report by email
If IsDebugMode = 0 Then On Error GoTo MySend_Error
DoCmd.SendObject acSendReport, Screen.ActiveReport.Name, acFormatPDF
MySend_Exit:
Exit Function
MySend_Error:
Call ErrorLog(Err.Description, Err.Number, "basRibbonCallback", Erl, "MySend")
Resume MySend_Exit
End Function
Public Function MyExport(strFormat As String)
'this is used on the report ribbon to export a report
Dim strFileType As String
Dim strFileFilter As String
Dim strfilename As String
If IsDebugMode = 0 Then On Error GoTo MyExport_Error
Select Case strFormat
Case "RTF" ' word
strFileType = acFormatRTF
strFileFilter = "*.rtf"
Case "XLS" ' excel
strFileType = acFormatXLS
strFileFilter = "*.XLS"
Case "TXT" ' text
strFileType = acFormatTXT
strFileFilter = "*.txt"
Case "HTML"
strFileType = acFormatHTML
strFileFilter = "*.html"
Case "PDF"
strFileType = acFormatPDF
strFileFilter = "*.pdf"
Case Else
Exit Function
End Select
strfilename = SaveFileName(strFileType, strFileType, strFileFilter)
If strfilename <> "" Then
DoCmd.OutputTo acOutputReport, Screen.ActiveReport.Name, strFileType, strfilename
End If
MyExport_Exit:
Exit Function
MyExport_Error:
Call ErrorLog(Err.Description, Err.Number, "basRibbonCallback", Erl, "MyExport")
Resume MyExport_Exit
End Function
Public Function SaveFileName(strTitle As String, strFilterText As String, strFilter As String) As String
'this is used on the report ribbon to export a report
If IsDebugMode = 0 Then On Error GoTo SaveFileName_Error
strFilter = ahtAddFilterItem(strFilter, strFilterText, strFilter)
SaveFileName = ahtCommonFileOpenSave( _
OpenFile:=False, _
Filter:=strFilter, _
DialogTitle:=strTitle, _
Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
SaveFileName_Exit:
Exit Function
SaveFileName_Error:
Call ErrorLog(Err.Description, Err.Number, "basRibbonCallback", Erl, "SaveFileName")
Resume SaveFileName_Exit
End Function
