Menambah Icon Pada Userform

Properti Userform pada VBA tidak memiliki properti untuk menambah sebuah icon. Agar bisa menambahkan sebuah icon pada userform, bisa menggunakan Windows API.

Simpan script Windows API dibawah ini kedalam module

'Author : vba.co.id
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
        (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
#Else
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
        (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
#End IF

Function BuatIcon(caption As String)
Dim Hwnd As Long
Dim iconPath As String
Dim xIcon As Long
Dim msg As Long

iconPath = "C:\LokasiFile\NamaFile.ico"

Hwnd = FindWindow("ThunderDframe", caption)
xIcon = ExtractIcon(0, iconPath, 0)

SendMessage Hwnd, WM_SETICON, 1, xIcon
SendMessage Hwnd, WM_SETICON, 0, xIcon

End Function

Setelah itu panggil pada Form yang ingin ditambagkan icon, dengan script

Private Sub UserForm_Initialize()
BuatIcon Me.caption
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *

Chat WhatsApp
WhatsApp