KODE MACRO USERFORM SESUAI LAYAR
Bagaimana Cara Membuat Userform Excel Full Responsive yang sesuai dengan layar Komputer ?
Berikut adalah cara dan langkah-langkah :
1. Buka Microsoft Excel Anda
2. Tekan Alt+F11 (masuk ke Jendela VBA(Visual Basic for Application))
3. Buat 1 buah Userform dan 1 buah frame
4. Klik userform 2x dan pastekan kode macro dibawah ini
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim Factor As Single
Factor = 0.75 'adjust to suit
Me.Width = GetSystemMetrics32(0) * Factor '< in pixels
Me.Height = (GetSystemMetrics32(1) * Factor) - 5
End Sub
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim Factor As Single
Factor = 0.75 'adjust to suit
Me.Width = GetSystemMetrics32(0) * Factor '< in pixels
Me.Height = (GetSystemMetrics32(1) * Factor) - 5
End Sub
5. Sekarang silihkan run atau tekan F5
6. Jika berhasil maka sekarang silahkan Anda coba 2 jenis lagi dari kami, caranya sama, tinggal ganti kode
Ke 2 :
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim hwnd&
hwnd& = FindWindow(vbNullString, Me.Caption)
DrawMenuBar hwnd
SetWindowLong hwnd, -22, &H40000 'menghilangkan border
End Sub
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim hwnd&
hwnd& = FindWindow(vbNullString, Me.Caption)
DrawMenuBar hwnd
SetWindowLong hwnd, -22, &H40000 'menghilangkan border
End Sub
Ke 3 :
Private ScrWidth&, ScrHeight&
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim hwnd&
hwnd& = FindWindow(vbNullString, Me.Caption)
SetWindowLong hwnd, -16, &H4080080 'menghilangkan caption
DrawMenuBar hwnd
SetWindowLong hwnd, -20, &H40000 'menghilangkan border
End Sub
Private ScrWidth&, ScrHeight&
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim hwnd&
hwnd& = FindWindow(vbNullString, Me.Caption)
SetWindowLong hwnd, -16, &H4080080 'menghilangkan caption
DrawMenuBar hwnd
SetWindowLong hwnd, -20, &H40000 'menghilangkan border
End Sub
Ke 4 :
Private ScrWidth&, ScrHeight&
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim hwnd&
hwnd& = FindWindow(vbNullString, Me.Caption)
SetWindowLong hwnd, -16, &H4080080 'menghilangkan caption
DrawMenuBar hwnd
SetWindowLong hwnd, -22, &H40000 'menghilangkan border
End Sub
Private ScrWidth&, ScrHeight&
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal wNewWord&)
Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd&)
Private Sub UserForm_Activate()
Me.Frame1.Width = Me.Width - Me.Frame1.Left - Me.Frame1.Left
End Sub
Private Sub UserForm_Initialize()
Dim hwnd&
hwnd& = FindWindow(vbNullString, Me.Caption)
SetWindowLong hwnd, -16, &H4080080 'menghilangkan caption
DrawMenuBar hwnd
SetWindowLong hwnd, -22, &H40000 'menghilangkan border
End Sub
Jika Anda melakukan dengan benar serta penempatan kode juga benar maka kode akan berjalan dengan baik dan semestinya, dan akhir salam jabat erat.
Post a Comment for "VBA CARA MEMBUAT USERFORM EXCEL FULL RESPONSIVE"