Ketika sebuah UserForm ditampilkan, maka pengguna tidak dapat mengakses lembar kerja atau sel yang ada di dalamnya (kecuali pengaturan tampilan UserForm diatur menjadi modeless) dan sel tersebut dapat kembali di akses ketika UserForm disembunyikan atau di tutup.
Namun untuk beberapa hal, barangkali kita menginginkan agar UserForm dapat disembunyikan atau disimpan ke System Tray saat pengguna mengklik tombol tertentu. Tutorial ini berisi tentang cara bagaimana agar UserForm dapat tersimpan atau terletak di System Tray, Hasil akhir dari tutorial ini akan tampak seperti berikut :
Membuat UserForm
+ .Buatlah sebuah UserForm (UserForm1)dengan dua buah tombol masing-masing dengan nama CommanButton1 dan CommandButton2, seperti terlihat dalam ilustrasi berikutMenambahkan Module
+ .Untuk menambahkan sebuah Module, Klik menu Insert Module+ .Selanjutnya tempelkan kode berikut didalamnya
Declare Function SetForegroundWindow Lib "User32" (ByVal hwnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
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
Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName _
As String, ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst _
As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)
Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Public nfIconData As NOTIFYICONDATA
Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean
Public Sub Hook(Lwnd As Long)
If Hooking = False Then
FHandle = Lwnd
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
Hooking = True
End If
End Sub
Public Sub Unhook()
If Hooking = True Then
SetWindowLong FHandle, GWL_WNDPROC, WndProc
Hooking = False
End If
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
If Hooking Then
If lParam = WM_LBUTTONDBL Then
UserForm1.Show 1
WindowProc = True
' Unhook
Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, _
Tip As String)
With nfIconData
.hwnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = Len(nfIconData)
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub
Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function
Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal _
nIconIndex As Long) As Long
ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function
Sub ShowUserForm()
Application.Visible = False
UserForm1.Show 1
End Sub
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
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
Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName _
As String, ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst _
As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)
Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Public nfIconData As NOTIFYICONDATA
Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean
Public Sub Hook(Lwnd As Long)
If Hooking = False Then
FHandle = Lwnd
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
Hooking = True
End If
End Sub
Public Sub Unhook()
If Hooking = True Then
SetWindowLong FHandle, GWL_WNDPROC, WndProc
Hooking = False
End If
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
If Hooking Then
If lParam = WM_LBUTTONDBL Then
UserForm1.Show 1
WindowProc = True
' Unhook
Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, _
Tip As String)
With nfIconData
.hwnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = Len(nfIconData)
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub
Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function
Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal _
nIconIndex As Long) As Long
ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function
Sub ShowUserForm()
Application.Visible = False
UserForm1.Show 1
End Sub
+ Kode macro untuk UserForm
Private Sub CommandButton1_Click()
Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String
Me_hWnd = FindWindowd("ThunderDFrame", UserForm1.Caption)
IconPath = Application.Path & Application.PathSeparator & "excel.exe"
Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
Hook Me_hWnd
AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Application.Visible = True
Unload Me
End Sub
Private Sub UserForm_Activate()
RemoveIconFromTray
Unhook
End Sub
Private Sub UserForm_Initialize()
CommandButton1.Caption = "Minimize to tray"
CommandButton2.Caption = "Close this form"
Application.Visible = False
End Sub
Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String
Me_hWnd = FindWindowd("ThunderDFrame", UserForm1.Caption)
IconPath = Application.Path & Application.PathSeparator & "excel.exe"
Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
Hook Me_hWnd
AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Application.Visible = True
Unload Me
End Sub
Private Sub UserForm_Activate()
RemoveIconFromTray
Unhook
End Sub
Private Sub UserForm_Initialize()
CommandButton1.Caption = "Minimize to tray"
CommandButton2.Caption = "Close this form"
Application.Visible = False
End Sub
Test UserForm System Tray
Untuk mencoba hasil akhir dari kerjaan, jalankan UserForm dengan cara tekan tombol F5 di keyboard anda. Atau anda dapat menggunakan kode untuk menjalankan UserForm ini secara otomatis saat file dibuka.Catatan
Ketika Anda menjalankan UserForm ini, apabila terdapat sebuah atau beberapa dokumen Excel yang terbuka - maka akan secara otomatis dokumen tersebut di sembunyikan, dan hanya akan menampilkan UserForm ini.Download - Sampel artikel ini
Baca juga artikel yang berkatiatan dengan artikel ini
Membuat loading di userform
Text berjalan pada userform Excel
Membuat loading dengan macro
Mengatasi Error in loading dll
Follow IG Wasis Zain atau Like fanpage Excel Pro
Demikian tips UserForm Terletak di System Tray, tips ini bisa diaplikasikan dimicrosoft excel vvisual basic for application, semoga dapat dipahami dengan baik, aamiin
Kombinasikan tups ini dengan tips berikut Macro Berjalan Otomatis Saat Membuka File Excel