VBA CARA MEMBUAT USERFORM EXCEL FULL RESPONSIVE

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

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

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

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

Jika Anda melakukan dengan benar serta penempatan kode juga benar maka kode akan berjalan dengan baik dan semestinya, dan akhir salam jabat erat.

مشاركة :