UserForm Tampil Full

        USERFORM FULL DEKSTOP

Materi  Pembelajaran VBA kali ini adalah bagaimana kita menampilkan sebuah userform tampil full di desktop pada computer anda

Cukup mudah caranya ikuti langkah – langkahnya sebagai berikut :

Pertama kita buka lembar kerja excel  kemudian seperti biasa kita masuk di VBA Property dengan dengan menggunakan tombol pintasan di keyboard anda

ALT + F11

Setelah tampil jendela vba propertinya buatlah

1 buah Userform
1 buah Cammadbuton
          Untuk tombo exit
1 buah label
            Untuk menampilkan tulisan berjalan pada userform

Yang semuanya sudah dibuat dan  dimodif sedemikian rupa sehingga tampil indah sesuai pilihan warna selera anda

Pada userform pastekan kode macro berikut

Dim Berhenti As Boolean
Private Sub UserForm_Initialize()
    With Application
        .WindowState = xlMaximized
        Zoom = Int(.Width / Me.Width * 100)
        Width = .Width
        Height = .Height
    End With
End Sub

Private Sub UserForm_Activate()
    Call Mulai
    End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Berhenti = True
     If CloseMode = 0 Then
Cancel = True
MsgBox "Untuk  Menutup Form silakan klik tombol Masuk", vbCritical
End If
End Sub

Private Sub Mulai()
    Dim j As Long
   
Awal:
    DoEvents
    If Berhenti = True Then Exit Sub
    Label9.Left = Label9.Left - 2
    If Label9.Left <= -Me.Width Then Label9.Left = Me.Width
      For j = 1 To 6543210: Next
    GoTo Awal
End Sub

Private Sub CommandButton1_Click()
Unload Me
Sheets("Sheet1").Select
End Sub

Pada modul pastekan kode berikut :

Sub fulldekstop()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next
End Sub

Selesai
Silahkan dipraktekan di lembar kerja anda
Semoga bermanfaat

Dapatkan tutorial lansung belajar vba dari awal sampai mahir melalu kontak dengan buku panduan  Paket Belajar vba lengkap  

PUTU ASANA
Wa . 082 396 256 527

Sampel file Userform full desktop dapat di unduh pada link berikut ini