Please para expert VB, tolong dong bagaimana cara mencari nama parent
menu dari menu yang ada..
saya sudah dapat tapi untuk caption-nya, bukan nama-nya dari parent menu.
Hal ini akan menjadi salah jika ada caption yang sama, jadi saya butuh
nama menu karena nama menu tidak mungkin sama dalam satu form....
berikut ini module yang saya buat untuk mendapatkan caption parent
menu dari menu yang ada di form tertentu.
'----------------------------------------------------------------------
'Coding di module
Option Explicit
Private Declare Function GetMenu Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long
Private Declare Function GetMenuString Lib "user32" _
Alias "GetMenuStringA" (ByVal hMenu As Long, _
ByVal wIDItem As Long, ByVal lpString As String, _
ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Const MF_BYPOSITION = &H400&
Type tMenu
NmMenu As String
nmParent As String
nmLocation As Long
nmMenuName As String
End Type
Public Function CekMenuNameFromCaption(ByVal fNamaForm As Form, _
ByVal sCaptionMenu As String)
As String
On Error GoTo ErrHandle
Dim oMenu As Object
For Each oMenu In fNamaForm
If TypeOf oMenu Is Menu Then
If (UCase(oMenu.Caption) = UCase(sCaptionMenu)) Then
CekMenuNameFromCaption = oMenu.Name
End If
End If
Next oMenu
Exit Function
ErrHandle:
Err.Raise Err.Number, , "Module Utility (CekMenuNameFromCaption), " &
Chr(13) & Err.Description
End Function
Private Function AnyLit(hSubSubMenu As Long) As Long
On Error GoTo ErrHandle
Dim i As Long
Dim MenuCount As Long
MenuCount = GetMenuItemCount(hSubSubMenu)
For i = 0 To MenuCount - 1
AnyLit = True
Exit Function
Next i
AnyLit = False
Exit Function
ErrHandle:
Err.Raise Err.Number, , "Module Utility (AnyLit), " & Chr(13) &
Err.Description
End Function
Private Function CekSubMenu(hSubMenu As Long, TheForm As Form,
MnuParent As String) As tMenu
On Error GoTo ErrHandle
Dim i As Long
Dim MenuItems As Long
Dim hSubSubMenu As Long
Dim buffer As String
Dim result As Long
MenuItems = GetMenuItemCount(hSubMenu)
For i = 0 To MenuItems - 1
hSubSubMenu = GetSubMenu(hSubMenu, i)
buffer = Space(255)
result = GetMenuString(hSubMenu, i, buffer, _
Len(buffer), MF_BYPOSITION)
buffer = Left$(buffer, result)
CekSubMenu.nmParent = MnuParent
CekSubMenu.NmMenu = buffer
CekSubMenu.nmLocation = i
CekSubMenu.nmMenuName = CekMenuNameFromCaption(TheForm, buffer)
If CekSubMenu.NmMenu <> "" Then
MsgBox CekSubMenu.nmMenuName & "(" & CekSubMenu.NmMenu &
") -> Parent (" & _
CekMenuNameFromCaption(TheForm,
CekSubMenu.nmParent) & "(" & _
CekSubMenu.nmParent & ")), Location :" &
CekSubMenu.nmLocation
End If
If hSubSubMenu And AnyLit(hSubSubMenu) Then
CekSubMenu hSubSubMenu, TheForm, buffer
End If
Next i
Exit Function
ErrHandle:
Err.Raise Err.Number, , "Module Utility (WalkSubMenu), " & Chr(13) &
Err.Description
End Function
Public Function CekMenu(TheForm As Form) As tMenu
On Error GoTo ErrHandle
Dim hMenu As Long
Dim hSubMenu As Long
Dim i As Long
Dim MenuCount As Long
Dim buffer As String
Dim result As Long
hMenu = GetMenu(TheForm.hwnd)
If hMenu <> 0 Then
MenuCount = GetMenuItemCount(hMenu)
For i = 0 To MenuCount - 1
hSubMenu = GetSubMenu(hMenu, i)
buffer = Space(255)
result = GetMenuString(hMenu, i, buffer, _
Len(buffer), MF_BYPOSITION)
buffer = Left$(buffer, result)
CekMenu.NmMenu = buffer
CekMenu.nmLocation = i
CekMenu.nmParent = TheForm.Name
CekMenu.nmMenuName = CekMenuNameFromCaption(TheForm, buffer)
If CekMenu.NmMenu <> "" Then
MsgBox CekMenu.nmMenuName & "(" & CekMenu.NmMenu & ")
-> Parent(Form(" & _
CekMenu.nmParent & ")), Location :" &
CekMenu.nmLocation
End If
CekSubMenu hSubMenu, TheForm, buffer
Next i
End If
Exit Function
ErrHandle:
Err.Raise Err.Number, , "Module Utility (CekMenu), " & Chr(13) &
Err.Description
End Function
'---------------------------------------------------------------------
untuk memanggil saya taruh di form yang ada menu-nya
'--------------------------------------------------------------------
Private Sub Form_Load()
CekMenu Me
End Sub
'--------------------------------------------------------------------
Mohon bantuannya yah.....
sebelumnya saya ucapkan terima kasih....
Acep
