Menu buttons of a custom menu are not working (1 Viewer)

TVV

New member
Local time
Today, 07:53
Joined
Apr 19, 2010
Messages
5
Hi everybody,

The following problem occurred: I build two database for gathering information from two sectors of our organization. A third database is used as a management tool to open the most important reports of both databases. By pressing on a button in the third database, code below opens one of the external databases and the desired report. After that, the code creates a menubar with to buttons. The first one should open the print window and the second button should close the external database, but I don't seem to be able to get the buttons working. Any suggestions? Thanks!

Option Explicit

Function PrintExternalReport(ByVal oString As String, ByVal iDb As Integer)

Dim appAccess As Access.Application
Dim oStrDb As String
Dim oErr As String
Dim i As Integer
Dim myBar As CommandBar

On Error GoTo PrintExternalreport_ErrHandler

Set appAccess = CreateObject("Access.Application")

If iDb = 1 Then
oStrDb = "\\xxx.xxx.xxx.xxx\database1.mdb"
ElseIf iDb = 2 Then
oStrDb = "\\xxx.xxx.xxx.xxx\database2.mdb"
End If

appAccess.Visible = False

'Open database in Current Microsoft Access window.
appAccess.OpenCurrentDatabase (oStrDb)

appAccess.DoCmd.Close acForm, "Mainmenu"
appAccess.Application.RunCommand acCmdAppMaximize

For i = 1 To appAccess.CommandBars.Count
appAccess.Application.CommandBars(i).Enabled = True
appAccess.Application.CommandBars(i).Enabled = False
Next i

'Open Report
appAccess.DoCmd.OpenReport oString, acViewPreview

Set myBar = appAccess.CommandBars.Add("Close and print", Position:=msoBarTop, MenuBar:=False, Temporary:=True)

With myBar
.Controls.Add Type:=msoControlButton, Id:=4
.Controls.Add Type:=msoControlButton
End With

With myBar.Controls(1)
.Style = msoButtonIconAndCaption
.Caption = "Print"
.OnAction = "=PrintMenu()"
.TooltipText = "Print this report"
End With

With myBar.Controls(2)
.Style = msoButtonCaption
.Caption = "Close"
.OnAction = "=CloseThisDb()"
.TooltipText = "Close"
End With

appAccess.Application.CommandBars("Close and print").Visible = True

appAccess.DoCmd.Maximize

Exit Function

PrintExternalReport_ErrHandler:
If Err.Number = 2501 Then
oErr = "Cancel"
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
Resume Next
Else
If oErr = "Cancel" Then
Resume Next
Else: MsgBox Error$(), , Err.Number & " " & Err.Description & "Print Acces Report"
End If
End If

End Function

Function printMenu()
appAccess.DoCmd.RunCommand (acCmdPrint)
End Function

Function CloseThisDb()
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
End Function
 

darbid

Registered User.
Local time
Today, 07:53
Joined
Jun 26, 2008
Messages
1,428
try this example which is a cut downversion of your code.

Open form 1. Click button. This should make your menu. Then click the buttons. Do you get a message?

MDB 2003 format
 

Attachments

  • db1.mdb
    120 KB · Views: 173

Users who are viewing this thread

Top Bottom