Solved

File Menu

Posted on 2003-10-23
35
607 Views
Last Modified: 2007-12-19
Is it possilbe to have a file menu in an access form?
0
Comment
Question by:Y2Kingswood
  • 15
  • 12
  • 8
35 Comments
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Yes,

Use the openfiledialog

OpenFileNameDlg(strTitle, strFilter, strDir)

Rem File/Open Dialog for 32 bit mode
' Hacked from Solutions.mdb by Trevor Best Dec 1997
' The functions to call are OpenFileNameDlg() and
' SaveFileNameDlg()

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
    "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type MSA_OPENFILENAME
    ' Filter string used for the Open dialog filters.
    ' Use MSA_CreateFilterString() to create this.
    ' Default = All Files, *.*
    strFilter As String
    ' Initial Filter to display.
    ' Default = 1.
    lngFilterIndex As Long
    ' Initial directory for the dialog to open in.
    ' Default = Current working directory.
    strInitialDir As String
    ' Initial file name to populate the dialog with.
    ' Default = "".
    strInitialFile As String
    strDialogTitle As String
    ' Default extension to append to file if user didn't specify one.
    ' Default = System Values (Open File, Save File).
    strDefaultExtension As String
    ' Flags (see constant list) to be used.
    ' Default = no flags.
    lngFlags As Long
    ' Full path of file picked.  When the File Open dialog box is
    ' presented, if the user picks a nonexistent file,
    ' only the text in the "File Name" box is returned.
    strFullPathReturned As String
    ' File name of file picked.
    strFileNameReturned As String
    ' Offset in full path (strFullPathReturned) where the file name
    ' (strFileNameReturned) begins.
    intFileOffset As Integer
    ' Offset in full path (strFullPathReturned) where the file extension begins.
    intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As Long
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10


Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file save dialog.
   
    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_to_OF msaof, of
    of.Flags = of.Flags Or OFN_HIDEREADONLY
    intRet = GetSaveFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetSaveFileName = intRet
End Function


Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the Open dialog.
   
    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_to_OF msaof, of
    intRet = GetOpenFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetOpenFileName = intRet
End Function


Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' This sub converts from the Win32 structure to the Microsoft Access structure.
   
    msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
    msaof.strFileNameReturned = of.lpstrFileTitle
    msaof.intFileOffset = of.nFileOffset
    msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the Microsoft Access structure to the Win32 structure.
   
    Dim strFile As String * 512

    ' Initialize some parts of the structure.
    of.hwndOwner = Application.hWndAccessApp
    of.hInstance = 0
    of.lpstrCustomFilter = 0
    of.nMaxCustrFilter = 0
    of.lpfnHook = 0
    of.lpTemplateName = 0
    of.lCustrData = 0
   
    If msaof.strFilter = "" Then
        of.lpstrFilter = "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar ' MSA_CreateFilterString(ALLFILES)
    Else
        of.lpstrFilter = msaof.strFilter
    End If
    of.nFilterIndex = msaof.lngFilterIndex
   
    of.lpstrFile = msaof.strInitialFile _
        & String(512 - Len(msaof.strInitialFile), 0)
    of.nMaxFile = 511

    of.lpstrFileTitle = String(512, 0)
    of.nMaxFileTitle = 511

    of.lpstrTitle = msaof.strDialogTitle

    of.lpstrInitialDir = msaof.strInitialDir
   
    of.lpstrDefExt = msaof.strDefaultExtension

    of.Flags = msaof.lngFlags
   
    of.lStructSize = Len(of)
End Sub

Function OpenFileNameDlg(pstrTitle As String, pstrFilter As String, Optional pstrInitialDir As String) As String
    ' Get Open File Name, to be backward compatible with the
    ' Access 2.0 version that passed "title", "filter|spec" params
    Dim strFilter  As String
   
    strFilter = CreateFilterString(pstrFilter)

    Dim msaof As MSA_OPENFILENAME
   
    ' Set options for the dialog box.
    msaof.strDialogTitle = pstrTitle
    msaof.strInitialDir = pstrInitialDir
    msaof.strFilter = strFilter ' MSA_CreateFilterString("Databases", "*.mdb")
   
    ' Call the Open dialog routine.
    MSA_GetOpenFileName msaof
   
    ' Return the path and file name.
    OpenFileNameDlg = Trim(msaof.strFullPathReturned)
End Function
Function SaveFileNameDlg(pstrTitle As String, pstrFilter As String, pstrDefault As String) As String
    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strFilter As String
   
    strFilter = CreateFilterString(pstrFilter)
   
    msaof.strFilter = strFilter
    msaof.strDialogTitle = pstrTitle
    msaof.strInitialFile = pstrDefault
   
    intRet = MSA_GetSaveFileName(msaof)
    SaveFileNameDlg = Trim(msaof.strFullPathReturned)
End Function
Private Function CreateFilterString(pstrFilter As String) As String
    Dim strFilter As String
    strFilter = pstrFilter
    Do Until Right(strFilter, 2) = "||"
        strFilter = strFilter & "|"
    Loop
    Do While InStr(strFilter, "|")
        Mid(strFilter, InStr(strFilter, "|"), 1) = vbNullChar
    Loop
    CreateFilterString = strFilter
End Function





0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Sorry,

To explain cut and paste the bottom bit into a module.  and insert into your code the

OpenFileNameDlg(strTitle, strFilter, strDir)

Where strTitle is the title of the dialog box, strFilter is what files you want people to open and strDir is where to start in.

EG:

strTitle = "Open Text File"
    strFilter = "Text Files|*.txt"
    strDir = "\"

This will return the string value of the name and directory of the file you choose.

Dom
0
 

Author Comment

by:Y2Kingswood
Comment Utility
how do i call it?
and what are strTitle, strFilter, strDir?
0
 

Author Comment

by:Y2Kingswood
Comment Utility
ummm... im not sure toy understood me..
i meant file menu as in

File Edit View Favortires Tools Help .... Etc
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Oh, you mean custome menus.  Yes you can create your own custom menus with Access.

On the View menu, point to Toolbars, and then click Customize.


On the Toolbars tab, click New.


In the Toolbar Name box, type the name you want, and then click OK.


On the Toolbars tab, click Properties.


In the Type list, click Menu Bar.


Set any other properties you want, and then click Close.
The new menu bar is now placed to the right of the Customize dialog box.

To complete the menu bar, do the following:

On the View menu, point to Toolbars, and then click Customize.


Show the menu bar, shortcut menu, or toolbar you want to add a command to.


Click the Commands tab.


In the Categories box, do any of the following: To add a Click  
Built-in command The appropriate menu or view category
Buttons for navigating HTML pages Web
Buttons for working with SourceSafe Source Code Control
Command for creating custom controls ActiveX Controls
Command that displays a form, report, or other database object in its default view One of the following: All Tables, All Queries, All Forms, All Reports, All Web Pages.
If you're in a Microsoft Access project, you'll see All Database Diagrams, All Views, and All Stored Procedures.
 
Command that runs a macro All Macros

Drag the command you want from the Commands box over the menu on the menu bar, Shortcut Menus toolbar, or other toolbar. When the menu displays a list of menu commands (or a blank box if it's new), point to the location where you want the command to appear on the menu, and then release the mouse.
Notes

You can also add a command that runs a Visual Basic function. For more information, click .


You can display shortcut key text for the command. For more information, click .


If you add a command to a menu (for example, the Edit menu), that command appears in all views that have that menu.

0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
All that is from MS Access Help.  Searched for custom menus

Hope that helps.

Dom
0
 

Author Comment

by:Y2Kingswood
Comment Utility
how do i make that show on the form? and not the access tool bar?
0
 

Author Comment

by:Y2Kingswood
Comment Utility
i need something that efectivly does what the menu editor in vb does
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Under the form properties, under all, is menu bar.  You can set this to be the menu bar you want to use for that form.

Dom
0
 

Author Comment

by:Y2Kingswood
Comment Utility
it doesnt attach it self to the form it just opens when the form opens.. it doesnt stick to the form its not part of the form its still a seperate bar... do you know what i mean?
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Yeah, I'll see what I can do to help ya. :)

Dom
0
 

Author Comment

by:Y2Kingswood
Comment Utility
Thanks
0
 
LVL 5

Accepted Solution

by:
gwgaw earned 65 total points
Comment Utility
You can't put an Access menu bar on a form. However, you can use labels to simulate a menu bar on a form. If you want to go down that road. I can post the code when I get home from work in a couple hours.

gaw
0
 

Author Comment

by:Y2Kingswood
Comment Utility
*groans* .. its more trouble than its worth...
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
gaw,

Post the code anyway. It would be worth a look :)

Dom
0
 

Author Comment

by:Y2Kingswood
Comment Utility
i dunno what to do with these points
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Split them or keep them.  Either way I'm happy.

Dom
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:Y2Kingswood
Comment Utility
lol i cant keep them.
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Yeah ya can.   If the answers to the question you asked do not work then no one has satisfactorily answered your question.  In which case you can ask for a refund and for the question to be closed from Community Support.  I would support you on this.

However with them only being 65 points is it worth it?  Up to you.

Dom
0
 

Author Comment

by:Y2Kingswood
Comment Utility
ive only got 100. lol who do i ask for a refund. normaly i wouldnt care but i dont have many points :P
0
 
LVL 5

Expert Comment

by:gwgaw
Comment Utility
Ok Dom, will do. I've used it in Access 2K and 2K2, should work in 97 also.

It don't matter to me about the points

gaw
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Fair enough.

Go to community support and post the url for this question as:

Refund Please http://www.experts-exchange.com/Databases/MS_Access/Q_20776522.html#9611795

Then explain why the refund.  They'll read all this anyway.

You don't need to ask for anyone.

Dom
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
I use Access 2K also but have just got 2003.  If you get it make sure ya get the jet 4.0 service pack 8 and turn off security settings otherwise it's an arse.

Dom
0
 
LVL 5

Expert Comment

by:gwgaw
Comment Utility
I just got 2K3 but havn't installed it yet. Thanks for the tip on jet sp8.

gaw
0
 
LVL 5

Expert Comment

by:gwgaw
Comment Utility
First installment.

You will need to set a reference to the Office Object library.

Common properties for all menu lables
Back Style = transparent
Back Color = 15651521
Border Style = transparent
Border Color = 12937777
Top = 0.0313"  (45 twips)
Height = 0.1979"  (285 twips)
Font Name  = Tahoma
Font Size = 8
Text Align = Center
Top Margin = 0.0313"  (45 twips)
***** End common properties *****

Width is dependent on caption. eg File = 0.3333" (480 twips), Edit = 0.3542" (510 twips)
Tag = Name of popup menu to use, eg File = FilePopup, Edit = EditPopup. You will have to create your own popup menus and functions for them.

I don't recommend using accelerator keys as Access may interpret them for it's menu.

All lables caption must begin with mnu eg; mnuFile, mnuEdit.

Generally I place the labels in the header section.
Place a subform control on the form with the menu lables. Set it's Visile property to false. Set it's Source Object to frmMnuHandler. Name it sbfMenus.

I plan on changing the code to use WithEvents but haven't got to it yet.

Mouse down and move events for labels.

Private Sub mnuEdit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
sbfMenus.Form.Button_MouseDown mnuEdit, Button, X, Y
End Sub

Private Sub mnuEdit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
sbfMenus.Form.Button_MouseMove mnuEdit, Button, X, Y
End Sub

Private Sub mnuFile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
sbfMenus.Form.Button_MouseDown mnuFile, Button, X, Y
End Sub

Private Sub mnuFile_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
sbfMenus.Form.Button_MouseMove mnuFile, Button, X, Y
End Sub

gaw
0
 
LVL 5

Expert Comment

by:gwgaw
Comment Utility
>All lables caption must begin with mnu eg; mnuFile, mnuEdit.<--- wrong

Should be
All lables names must begin with mnu eg; mnuFile, mnuEdit.

gaw
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Cool, got first installment.  

Dom
0
 
LVL 5

Expert Comment

by:gwgaw
Comment Utility
Second installment.

Create a new form and paste the following code into its module.

Option Compare Database
Option Explicit
'****************************************************************
'* frmMnuHandler by Gary A Wiley
'* Copyright 2000. All rights reserved.
'* Updated 12/2002 to flat menus
'*
'* DISCLAIMER
'* By using this code you agree to indemnify Gary A Wiley
'* from any liability whatsoever that might arise from it's use.
'*
'* This code may be used, modified, distributed, sold, mangled,
'* spit on, stepped on or totally trashed by any means necessary
'* free of charge by anyone so long as the copyright notice and
'* the comments above remain intact. (Chuckle) :)
'****************************************************************
'* Menubar button handler to simulate a menubar on Access forms
'* Menubar buttons must be labels with mnu for first 3 chars in name
'* Tag prop of labels must be name of popup menu to show
Private CurMnu As Label
Private Mnus() As Label
Private cbMnu As CommandBar
Private Pos As POINTAPI
Private bnMouseDown As Boolean
Private MnuUp As Boolean
'GetDeviceCaps constants
Private Const LOGPIXELSX = 88   'Pixels per logical inch in X
Private Const LOGPIXELSY = 90   'Pixels per logical inch in Y

Private Const BACK_CLR_UP = 15651521
Private Const BDR_CLR_UP = 12937777
Private Const BDR_CLR_DOWN = 8029834
Private Const STYLE_TRANS = 0
Private Const STYLE_SOLID = 1

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptX As Long, ByVal ptY As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Public Sub Button_MouseDown(lbl As Label, Button As Integer, X As Single, Y As Single)
'Called by parent form's label mousedown event
If Button <> 1 Then Exit Sub
If MnuUp Then
    MnuUp = False
    DrawMnuUp lbl
Else
    DrawMnuDown lbl
    If Me.TimerInterval <> 100 Then Me.TimerInterval = 100
    ShowMnu lbl
End If
End Sub

Public Sub Button_MouseMove(lbl As Label, Button As Integer, X As Single, Y As Single)
'Called by parent form's label mousemove event
If Not CurMnu Is Nothing Then
    If CurMnu.Name <> lbl.Name Then
        DrawMnuFlat CurMnu
    End If
End If
Set CurMnu = lbl
If Not MnuUp Then
    DrawMnuUp lbl
    If Me.TimerInterval <> 100 Then Me.TimerInterval = 100
End If
End Sub

Private Sub DrawMnuDown(lbl As Label)
bnMouseDown = True
lbl.BackStyle = STYLE_TRANS
lbl.BorderColor = BDR_CLR_DOWN
lbl.BorderStyle = STYLE_SOLID
End Sub

Private Sub DrawMnuFlat(lbl As Label)
lbl.BackStyle = STYLE_TRANS
lbl.BorderColor = BDR_CLR_UP
lbl.BorderStyle = STYLE_TRANS
End Sub

Private Sub DrawMnuUp(lbl As Label)
If lbl.BackStyle <> STYLE_SOLID Then lbl.BackStyle = STYLE_SOLID
If lbl.BorderColor <> BDR_CLR_UP Then lbl.BorderColor = BDR_CLR_UP
If lbl.BorderStyle <> STYLE_SOLID Then lbl.BorderStyle = STYLE_SOLID
End Sub

Private Sub Form_Close()
Set CurMnu = Nothing
Set cbMnu = Nothing
Erase Mnus
End Sub

Private Sub Form_Open(Cancel As Integer)
Dim frm As Form, ctl As Control
On Error Resume Next
'If this form doesn't have a parent then don't allow to open
Set frm = Me.Parent
If Err Then
    MsgBox "This form cannot run in stand alone mode.", vbCritical
    Cancel = True
    GoTo ExitHere
End If
MnuUp = False
'Get the form's menu labels into an array
For Each ctl In frm.Controls
    If ctl.ControlType = acLabel Then
        If Left$(ctl.Name, 3) = "mnu" Then
            On Error Resume Next
            ReDim Preserve Mnus(UBound(Mnus) + 1)
            If Err Then ReDim Mnus(0)
            Set Mnus(UBound(Mnus)) = ctl
        End If
    End If
Next
On Error GoTo ErrorHere
'This wiil generate an error if there are no menu lables
If UBound(Mnus) = -1 Then
End If
ExitHere:
Set ctl = Nothing
Set frm = Nothing
Exit Sub
ErrorHere:
If Err = 2452 Then
    MsgBox "This form is not designed to run as a stand alone form.", vbExclamation
ElseIf Err = 9 Then
    MsgBox "Could not find any menu labels.", vbExclamation
Else
    MsgBox "Error" & Err.Number & vbCrLf & Err.Description, vbExclamation
End If
Resume ExitHere
End Sub

Private Sub Form_Timer()
Dim frm As Form, lbl As Label
Dim pt As POINTAPI
Dim i As Long
If CurMnu Is Nothing Then  'No menu so quit
    Me.TimerInterval = 0
    Exit Sub
End If
Set frm = Me.Parent
'Get the cursor position and convert to parent form's coordinates
GetCursorPos pt
ScreenToClient frm.hWnd, pt
Set frm = Nothing
'Convert to twips
pt.X = pt.X * TwipsPerPixelX
pt.Y = pt.Y * TwipsPerPixelY
If MnuUp Then
    'Check if mouse is on a menu label
    For i = 0 To UBound(Mnus)
        Set lbl = Mnus(i)
        If pt.X > lbl.Left And pt.X < lbl.Left + lbl.Width - 15 _
        And pt.Y > lbl.Top And pt.Y < lbl.Top + lbl.Height - 15 Then
            'If it's not the current menu label then show new popup menu
            If CurMnu.Name <> lbl.Name Then
                DrawMnuFlat CurMnu
                Set CurMnu = lbl
                mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0    'Hides current popup menu
                mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0    'Shows new popup menu
                Exit For
            End If
        End If
    Next i
    If i > UBound(Mnus) Then
        'Update menubar if user clicked a menu item or outside the popup menu
        If Not cbMnu.Visible Then
            DrawMnuFlat CurMnu
            MnuUp = False
            Me.TimerInterval = 0
        End If
    End If
Else
    'Test for cursor off the current menu
    If pt.X < CurMnu.Left Or pt.X > CurMnu.Left + CurMnu.Width - 15 _
    Or pt.Y < CurMnu.Top Or pt.Y > CurMnu.Top + CurMnu.Height - 15 Then
        DrawMnuFlat CurMnu
        Me.TimerInterval = 0
        Set CurMnu = Nothing
    End If
End If
End Sub

Private Sub ShowMnu(lbl As Label)
Dim frm As Form
Dim pt As POINTAPI
If lbl.Tag = "" Then Exit Sub   'Label does not have a popup menu name
Set frm = Me.Parent
'Determine position for popup menu
pt.X = lbl.Left / TwipsPerPixelX - 1
pt.Y = (lbl.Top + lbl.Height) / TwipsPerPixelY - 2
ClientToScreen frm.hWnd, pt
Set frm = Nothing
Set cbMnu = CommandBars(lbl.Tag)
MnuUp = True
cbMnu.ShowPopup pt.X, pt.Y
End Sub

Private Function TwipsPerPixelX() As Long   'Twips per pixel for screen in X
Dim lgDC As Long, lgHwnd As Long
lgHwnd = GetDesktopWindow
lgDC = GetDC(lgHwnd)
TwipsPerPixelX = 1440 / GetDeviceCaps(lgDC, LOGPIXELSX)
ReleaseDC lgHwnd, lgDC
End Function

Private Function TwipsPerPixelY() As Long   'Twips per pixel for screen in Y
Dim lgDC As Long, lgHwnd As Long
lgHwnd = GetDesktopWindow
lgDC = GetDC(lgHwnd)
TwipsPerPixelY = 1440 / GetDeviceCaps(lgDC, LOGPIXELSY)
ReleaseDC lgHwnd, lgDC
End Function

Private Sub GetButtonPosition(rcBtn As RECT, ByVal MDiHwnd As Long)
Dim lgBorderWidth As Long, lgCaptionHeight As Long
Dim lgSelectorWidth As Long, lgSectionHieghts As Long
Dim ptF As POINTAPI, rc1 As RECT
Dim dl As Long
Dim frm As Form
Set frm = Me.Parent.Name
With frm
    'Get form's border width and caption height
    lgBorderWidth = (.WindowWidth - .InsideWidth) / 2
    lgCaptionHeight = (.WindowHeight - .InsideHeight - lgBorderWidth)
    'If the form's NavigationButtons property is true we need to subtract
    'the height of the navigation buttons from the caption height
    'by subtracting the form's InsideHeight from it's client height
    If .NavigationButtons Then
        dl = GetClientRect(.hWnd, rc1)   'rc1.Bottom is the form's client height in pixels
        lgCaptionHeight = lgCaptionHeight - (rc1.Bottom * TwipsPerPixelY - .InsideHeight)
    End If
    'If the form's RecordSelectors property is true we need to
    'add the width of the record selector to the button's Left property
    'by subtracting the form's Width from its InsideWidth
    lgSelectorWidth = .InsideWidth - .Width
    'Get form's position in screen coordinates
    dl = GetWindowRect(.hWnd, rc1)
End With
'Convert form's left, top position to MDIClient coordinates
ptF.X = rc1.Left: ptF.Y = rc1.Top
ScreenToClient MDiHwnd, ptF
With frm(CurMnu)
    'Get the parent form's section hieghts
    lgSectionHieghts = SectionHieghts(.Section)
    'Get the button's position in relation to the form's left and top
    ptF.X = ptF.X * TwipsPerPixelX + .Left + lgBorderWidth + lgSelectorWidth
    ptF.Y = ptF.Y * TwipsPerPixelY + .Top + lgCaptionHeight + lgSectionHieghts
    'Pass the button,s position and size back in rcBtn
    SetRect rcBtn, ptF.X, ptF.Y, ptF.X + .Width, ptF.Y + .Height
End With
Set frm = Nothing
End Sub

Private Function SectionHieghts(itSec As AcSection) As Long
'Returns the combined hieght of a form's visble sections
Dim lgHeight As Long
Dim frm As Form
On Error Resume Next
Set frm = Me.Parent.Name
With frm
    If itSec = acDetail Then
        If .Section(acHeader).Visible Then
            lgHeight = .Section(acHeader).Height
        End If
    End If
    If itSec = acFooter Then
        If .Section(acHeader).Visible Then
            lgHeight = .Section(acHeader).Height
        End If
        lgHeight = lgHeight + .Section(acDetail).Height
    End If
End With
SectionHieghts = lgHeight
Set frm = Nothing
End Function
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Thanks Gaw,

I am going to save the web page to HDD to recall what you've sent (Then put it in my source library) so if that's all of it thank you very much, otherwise post the lot and let me know when it's all here.

Thanks again,

Dom
0
 
LVL 5

Expert Comment

by:gwgaw
Comment Utility
Last installment.

I usually create the popup menus when the form opens and set the temporary argument to true in the CommandBars.Add method. Example of code for creating popupmenus...

Dim cb As CommandBar, cbBtn As CommandBarButton
On Error GoTo ErrorHere
Set cb = CommandBars.Add("FilePopup", msoBarPopup, False, True)
Set cbBtn = cb.Controls.Add(msoControlButton, , , , True)
cbBtn.Caption = "Add From Text File"
cbBtn.Style = msoButtonCaption
cbBtn.OnAction = "AddFromFile"
Set cbBtn = cb.Controls.Add(msoControlButton, , , , True)
cbBtn.Caption = "Exit"
cbBtn.Style = msoButtonCaption
cbBtn.OnAction = "ExitMe"
cbBtn.BeginGroup = True

Set cb = CommandBars.Add("EditPopup", msoBarPopup, False, True)
Set cbBtn = cb.Controls.Add(msoControlButton, , , , True)
cbBtn.Caption = "Copy"
cbBtn.Style = msoButtonCaption
cbBtn.OnAction = "CopyItems"

gaw
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Hi Gaw,

Thanks very much.  This will be very useful.  Like Y2Kingswood I use menu editor in VB6 and have been creating buttons instead of menus for Access but it can be a pain if you have lots of levels.

Thanks again.

Dom
0
 
LVL 5

Expert Comment

by:gwgaw
Comment Utility
By the way, the GetButtonPosition sub is a carry over I forgot to take out. You can remove it as it does not get used.

gaw
0
 

Author Comment

by:Y2Kingswood
Comment Utility
they wont refund my points
0
 
LVL 2

Expert Comment

by:dom_cath
Comment Utility
Why?  It's up to them I guess.  I guess that if you look at your question:

"Is it possilbe to have a file menu in an access form? "

then gaw has answered it fairly for you.  The answer is not in the way VB6.0 has it but he has posted a way to do it.  

Sorry bud, but my suggestion now is to accept gwgaw's answer as a legitimate answer.

Dom
0
 

Author Comment

by:Y2Kingswood
Comment Utility
yeah oh well
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Most if not all databases provide tools to filter data; even simple mail-merge programs might offer basic filtering capabilities. This is so important that, although Access has many built-in features to help the user in this task, developers often n…
Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now