Membuat Menu pada userform Excel

Senin, 24 April 2017

Membuat Menu pada userform Excel

April 24, 2017 2 Comments
Setelah melihat beberapa tampilan di program lain tentang menu horizontal, dropdown menu dan menu- menu lain yang ada pada beberapa aplikasi maka timbul pertanyaan bisa gak membuat menu pada userform excel? Jawaban setelah beberapa kali mencari akhirnya saya menemukan bagaimana cara membuat menu pada userform excel.

Tentunya untuk membuat menu ini kita harus menggunakan vb excel, dan data excel harus tersimpan dalam format macro excel. Apa saja yang harus dipersiapkan untuk membuat menu excel pada userform? yang harus dipersiapkan untuk membuat menu pada userform excel adalah tentunya userform, module yang diisi dengan script-script atau kode-kode program untuk menampilkan menu itu dan file excel untuk menyusun menu yang akan ditampilkan.

Sekarang akan saya uraikan bagaimana cara membuat menu pada userform excel, berikut adalah langkah-langkah untuk membuat menu pada userform excel :

  1. Bukalah file excel
  2. Cari menu tab developer kemudian pilih visual basic atau dengan menekan tombol alt bersama-sama dengan f11 pada keyboard sehingga tampil jendel visual basic seperti di bawah ini
    3. vbexcel

  3. Setelah tampil jendela visual basic klik insert kemudian klik userfom atau ukuran userform sesuai kebutuhan.
  4. Langkah selanjutnya klik insert lagi sekarang klik module lalu ketikan kode berikut:

    5. 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 = &H800&
    Public Const MF_POPUP = &H10
    Public Const MF_STRING = &H0


    Public Const IDM_MU As Long = &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, &O0, vbNullString)
                        Else
                            g_Rt(TopMNU) = AppendMenu(g_hPopUpMenu(TopMNU), _
                                MF_SEPARATOR, &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:=" & Err.Number & vbCrLf & _
                "Description:=" & Err.Description & vbCrLf & _
                "Check yur macro names!", vbCritical + vbMsgBoxHelpButton, _
                "Menu Macro Error", Err.HelpFile, Err.HelpContext
        End If
        Err.Clear
    End Sub

    agar kita bisa membedakn module yang itu maka gantilah nama module itu dengan basAPIMNU.
  5. Buat lagi module yang kedua sekarang ketikan kode berikut:

    6. 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 = &H111
    Private Const WM_MENUSELECT As Long = &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
    Gantilah module itu dengan nama basAPIMNU_hook
  6. Buat lagi module yang ketiga sekarang ketikan lagi kode berikut:


    7. 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

    Ganti nama module dengan nama BasAPIMNU_loader
  7.  buat lagi module ketikan kode berikut :

    8. Sub Kasbpnpm()
    MsgBox "Percobaan Menu"
    End Sub
    Ganti nama module itu dengan nama basAPIMNU_routines
     
    Module dengan nama basAPIMNU_Routines  Berfungsi untuk membuat kode macro dari setiap menu yang kita buat 

Itu adalah persiapan Userform dan module pada jendela visual basic untuk langkah selanjutnya kita harus mempersiapkan file excel agar menu tersebut berjalan Untuk file membuat menu pada userform excel tidak saya jelaskan di sini bisa dilihat dan di coba pada file yang telah saya sediakan di sini. dan inilah contoh animasi dari menu pada userform excel.
menu userform excel

2 komentar: