Membuat Menu Pada User Form Excel

Membuat Menu Pada User Form Excel

Menu yang tampil pada userform hanya menu bar tapi sub menunya tidak muncul, akan muncul ketika di klik saja

Pernahkah kita kepikiran untuk membuat menu pada excel, pada postingan sebelumnya saya pernah membahas membuat menu dengan hyperlink, untuk memanggil beberapa sheet, namun ketika kita ingin menjalankan macro dengan menu itu gimana?

Ilustrasi gambar di bawah ini menggambarkan bahwa membuat menu utama dengan userform.

simulasi menu userform

Berikut adalah langkah langkah untuk membuat menu pada userform excel:

1. Buatlah empat buah module
2. Buatlah sebuat userform
3. Buat sebuah sheet untuk menyusun menu 

Membuat Module

Setelah terbuat ketiga item itu ikuti langkah membuat menu untuk module ke satu uketikan kode berikut:
Option Explicit
Option Base 1
'Membuat Windows Menu dengan menggunakan API
'--------------------------------------------

'Membuat horizontal menu bar di bagian atas
Public Declare Function CreateMenu Lib "user32" () As Long

Public Declare Function CreatePopupMenu Lib "user32" () As Long

Public Declare Function FindWindow Lib "user32" _
        Alias ​​"FindWindowA" (_
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long

Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function AppendMenu Lib "user32" _
        Alias ​​"AppendMenuA" (_
            ByVal hMenu As Long, _
            ByVal wFlags As Long, _
            ByVal wIDNewItem As Long, _
            ByVal lpNewItem As String) As Long

Public Declare Function SetMenu Lib "user32" (_
        ByVal hwnd As Long, _
        ByVal hMenu As Long) As Long

Public Declare Function DestroyMenu Lib "user32" (_
        ByVal hMenu As Long) As Long

Public Declare Function SetWindowLong Lib "user32" _
        Alias ​​"SetWindowLongA" (_
            ByVal hwnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long

Public Const MF_SEPARATOR As Long = & amp; H800 & amp;
Public Const MF_POPUP = & amp; H10
Public Const MF_STRING = & amp; H0


Public Const IDM_MU As Long = & amp; H7D0 'Menu Item ID
'//
Public g_hPopUpMenu () As Long 'Popupmenu handles
Public g_hMenu As Long 'Userform menu handle
Public g_hPopUpSubMenu () As Long 'Submenu handles
Public g_Rt () As Long 'Values ​​for testing debuging
Public g_APIMacro () As String 'Routine names associated with Menus
Public g_hForm As Long 'Userform handle
Public g_MNUSheet As Worksheet 'Menu Sheet

Public Sub CreateAPIMenu ()
'Sub ini harusnya terekseusi jika terjadi init Userform
Dim RowNum As Long, _
    SubMNU As Long, _
    TopMNUitems As Long, _
    SubMNUItem As Long, _
    TopMNU As Long, _
    Rt As Long, _
    MacroNum As Long

'Set menusheet
Set g_MNUSheet = ThisWorkbook.Sheets ( "APIMNU")

with g_MNUSheet
    'Set-up now
    TopMNUitems = .Range ( "A1")
    SubMNU = .Range ( "B1")
 
    ReDim g_hPopUpMenu (TopMNUitems)
    ReDim g_Rt (TopMNUitems)
    ReDim g_hPopUpSubMenu (SubMNU)
    ReDim g_APIMacro (.Range ( "C1"). Value)
 
    'Main Menu Area at top
    g_hMenu = CreateMenu ()
    Rt = SetMenu (g_hForm, g_hMenu)
 
    'Initialize variables
    RowNum = 0
    MacroNum = 1
    SubMNUItem = LBound (g_hPopUpSubMenu)
 
    For TopMNU = 1 To TopMNUitems
        RowNum = RowNum + 1
        g_hPopUpMenu (TopMNU) = CreatePopupMenu ()
        If TopMNU = 1 Then
            g_Rt (TopMNU) = AppendMenu (g_hMenu, MF_POPUP, g_hPopUpMenu (TopMNU), .Cells (2 + RowNum, 2))
        else
            g_Rt (TopMNU) = AppendMenu (g_hMenu, MF_POPUP, g_hPopUpMenu (TopMNU), .Cells (1 + RowNum, 2))
        End If
        Do Until .Cells (2 + RowNum, 4) .Text = "END"
            Select Case .Cells (2 + RowNum, 1) .Value
                Case 1
                Case 0
                    If .Cells (1 + RowNum, 1) = 4 Then
                        g_Rt (TopMNU) = AppendMenu (g_hPopUpSubMenu (SubMNUItem - 1), _
                            MF_SEPARATOR, & amp; O0, vbNullString)
                    else
                        g_Rt (TopMNU) = AppendMenu (g_hPopUpMenu (TopMNU), _
                            MF_SEPARATOR, & amp; O1, vbNullString)
                    End If
                Case 2
                    g_Rt (TopMNU) = AppendMenu (g_hPopUpMenu (TopMNU), MF_STRING, _
                        IDM_MU + .Cells (2 + RowNum, 5), .Cells (2 + RowNum, 2))
                    g_APIMacro (MacroNum) = .Cells (2 + RowNum, 3) .Text
                    MacroNum = MacroNum + 1
                case 3
                    g_hPopUpSubMenu (SubMNUItem) = CreatePopupMenu ()
                    g_Rt (TopMNU) = AppendMenu (g_hPopUpMenu (TopMNU), MF_POPUP, _
                        g_hPopUpSubMenu (SubMNUItem), .Cells (2 + RowNum, 2))
                    SubMNUItem = SubMNUItem + 1
                 case 4
                    g_Rt (TopMNU) = AppendMenu (g_hPopUpSubMenu (SubMNUItem - 1), _
                        MF_STRING, IDM_MU + .Cells (2 + RowNum, 5), .Cells (2 + RowNum, 2))
                    g_APIMacro (MacroNum) = .Cells (2 + RowNum, 3) .Text
                    MacroNum = MacroNum + 1
                End Select
            RowNum = RowNum + 1
        loop
    Next TopMNU
End With

End Sub

Public Sub RunAPIMNUMacro (strMacroName As String)
    On Error Resume Next
    Application.Run (strMacroName)
    If Err Then
        MsgBox "Error number: =" & amp; Err.Number & amp; vbCrLf & amp; _
            "Description: =" & amp; Err.Description & amp; vbCrLf & amp; _
            "Check yur macro names!", VbCritical + vbMsgBoxHelpButton, _
            "Menu Macro Error", Err.HelpFile, Err.HelpContext
    End If
    Err.Clear
End Sub

Kemudian pada module yang kedua kita ketikan kode berikut:
Option Explicit

Public Declare Function CallWindowProc _
    Lib "user32" _
        Alias ​​"CallWindowProcA" (_
            ByVal lpPrevWndFunc As Long, _
            ByVal hwnd As Long, _
            ByVal Msg As Long, _
            ByVal wParam As Long, _
            ByVal lParam As Long) _
         As Long

Private Const WM_COMMAND = & amp; H111
Private Const WM_MENUSELECT As Long = & amp; H11F
Public g_lpMyWndProc As Long
Public Const GWL_WNDPROC = (-4)

Public Function HookWinProc (ByVal hw As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

    If uMsg = WM_COMMAND Then
        DoEvents
        Call RunAPIMNUMacro (g_APIMacro (wParam - IDM_MU))
    End If
    HookWinProc = CallWindowProc (g_lpMyWndProc, hw, uMsg, wParam, lParam)
 
End Function

Untuk module yang ketiga ketikan kode berikut:
Option Explicit

Sub Loader ()

    #If VBA6 Then
        frmTask.Show
    #Else
        sorry
    #End If

End Sub

Sub Sorry ()
    Dim Msg As String
 
    Msg = "Sorry .... dosen't run on Versions <2000 font=" ">
    MsgBox Msg, vbExclamation
    'Application.UserControl = False
    'Application.IgnoreRemoteRequests = True
End Sub
Untuk Module yang keempat ketikan buatlah macro sesuai dengan nama pada sheet menu utama sebagai contoh jika pada sheet menu
pada bagian nama macro test
maka kita buat pada module ke empat
sub test ()
Msgbox "Percobaan Menu"
end sub
buatlah macro sesuai kebutuhan kita terhadap menu tersebut.

Untuk membuat userform gantilah nama userform pada bagian properties namenya sesuai dengan sub loader ()
dalam sub loader tersebut nama userformnya adalah frmTask, maka nama userform kita juga harus frmTask.
kemudian double klik userform hapus semua kode yang ada ganti dengan
Option Explicit


Private Sub UserForm_Initialize ()
 
    'UserForm Handle
    g_hForm = FindWindow (vbNullString, Me.Caption)
 
    call CreateAPIMenu
 
    with Me
        .Height = 200 '250 - 45
        .Height = 253 'Original + 19
    End With
 
    g_lpMyWndProc = SetWindowLong (g_hForm, GWL_WNDPROC, AddressOf HookWinProc)

End Sub
Private Sub UserForm_QueryClose (Cancel As Integer, CloseMode As Integer)
    'Clean up
    DestroyMenu g_hMenu
    SetWindowLong g_hForm, GWL_WNDPROC, g_lpMyWndProc
End Sub
Private Sub UserForm_Terminate ()
    'Safety Clean up
    DestroyMenu g_hMenu
    SetWindowLong g_hForm, GWL_WNDPROC, g_lpMyWndProc
End Sub

Membuat User Form

Klik tombol Insert pada jendela visual basic kemudian klik userfom



langkah selanjutnya menyusun

Menu pada sheet

inilah ilustrasi menu sheet yang akan kita susun menu nya

untuk menu maka kode yang kita masukan di kolom a adalah satu

untuk sub menu kodenya adalah 2
ketika sub menu tersebut mengandung sub menu lagi maka kodenya tiga dan sub menu berikutnya adalah 4

pada kolom nama menu tentukanlah nama menu yang akan tampil pada userform
untuk kode 2 dan kode 4 maka macro name tidak bisa kosong.

untuk contoh filenya bisa di download disini .
Demikian cara membuat menu pada userform microsoft excel versi aplikasi keuangan.