Membuat Menu Pada User Form Excel

Membuat Menu Pada User Form Excel membuat menu pada userform excel

membuat menu utama dengan macro 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.

Membuat Menu Pada User Form Excel

Berikut adalah langkah langkah untuk membuat menu pada userform excel:

Buatlah empat buah module
Buatlah sebuat userform
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.

Membuat Menu Pada User Form Excel