-------------------------------------
EXCEL & VBA TUTORIAL : FORM UTAMA
-------------------------------------
Option Explicit
Private Sub CBOPEN_Click()
Application.Visible = True
Unload Me
End Sub
Private Sub CMDDELETE_Click()
If Me.TXTNOMOR.value = "" Then
Call MsgBox("pilih data pada tabel data", vbInformation, "Hapus data")
Else
Select Case MsgBox("anda akan menghapus data" _
& vbCrLf & "apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
Kill Me.TXTALAMAT.value
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
Sheet1.Select
Selection.EntireRow.Delete
Call Hitungrekap
Call AMBILDATA
Sheet1.Select
Call MsgBox("data berhasil dihapus", vbInformation, "simpan data")
End If
End Sub
Private Sub CMDDOKUMEN_Click()
FORMDOKUMEN.Show
End Sub
Private Sub CMDEXIT_Click()
Select Case MsgBox("Anda akan keluar dari Aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar Aplikasi")
Case vbNo
Exit Sub
Case vbYes
End Select
Application.Visible = True
Unload Me
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Private Sub CMDFOLDER_Click()
FORMFOLDER.Show
End Sub
Private Sub AMBILDATA()
Dim DBDOKUMEN As Long
Dim irow As Long
irow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
DBDOKUMEN = Application.WorksheetFunction.CountA(Sheet1.Range("A6:A900000"))
If DBDOKUMEN = 0 Then
FORMUTAMA.TABELDATA.RowSource = ""
Else
FORMUTAMA.TABELDATA.RowSource = "DATADOKUMEN!A6:G" & irow
End If
End Sub
Private Sub CMDOPEN_Click()
Dim ALAMATFILE As String
ALAMATFILE = Me.TXTALAMAT.value
If Me.TXTALAMAT.value = "" Then
Call MsgBox("Harap pilih data terlebih dahulu", vbInformation, "Pilih Data")
Else
If Me.TABELDATA.Column(5) = ".xlsx" Then
Application.Visible = True
Unload Me
Sheet1.Select
On Error Resume Next
ThisWorkbook.FollowHyperlink ALAMATFILE
Else
On Error Resume Next
ThisWorkbook.FollowHyperlink ALAMATFILE
End If
End If
End Sub
Private Sub CMDPRINT_Click()
Select Case MsgBox("Anda akan mencetak data" _
& vbCrLf & "apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Data")
Case vbNo
Exit Sub
Case vbYes
End Select
Sheet2.PrintOut
End Sub
Private Sub CMDRESET_Click()
Call AMBILDATA
Me.TXTCARI.value = ""
End Sub
Private Sub CMDSAVE_Click()
ThisWorkbook.Save
End Sub
Private Sub CMDUPDATE_Click()
On Error GoTo EXCELVBA
If Me.TXTNOMOR.value = "" Then
Call MsgBox("Harap pilih data pada tabel data", vbInformation, "Pilih Data")
Else
With FORMDOKUMEN
.TXTTGL.value = Format(CDate(Me.TABELDATA.Column(1)), "DD/MM/YYYY")
.TXTNODOKUMEN.value = Me.TABELDATA.Column(2)
.TXTNAMADOKUMEN.value = Me.TABELDATA.Column(3)
.CBJENIS.value = Me.TABELDATA.Column(4)
.CBTIPE.value = Me.TABELDATA.Column(5)
.TXTALAMAT.value = Me.TABELDATA.Column(6)
.CMDADD.Enabled = False
End With
FORMDOKUMEN.Show
End If
Exit Sub
EXCELVBA:
Call MsgBox("Maaf, data yang dipanggil tidak ditemukan", vbInformation, "Data
Dokumen")
End Sub
Private Sub OPTALL_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("J6").value = ""
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("J5:J6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub OPTBIASA_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("L6").value = "Biasa"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("L5:L6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub OPTEXCEL_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("J6").value = ".xlsx"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("J5:J6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub OPTJPG_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("J6").value = ".jpg"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("J5:J6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub OPTPDF_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("J6").value = ".Pdf"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("J5:J6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub HasilFilter()
Dim DBPDF As Long
Dim irow As Long
irow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
DBPDF = Application.WorksheetFunction.CountA(Sheet2.Range("A6:A900000"))
If DBPDF = 0 Then
FORMUTAMA.TABELDATA.RowSource = ""
Else
FORMUTAMA.TABELDATA.RowSource = "FILTERDOKUMEN!A6:G" & irow
End If
End Sub
Private Sub OPTPENTING_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("L6").value = "Penting"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("L5:L6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub OPTRAHASIA_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("L6").value = "Rahasia"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("L5:L6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub OPTWORD_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("J6").value = ".docx"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("J5:J6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub TABELDATA_Click()
On Error GoTo EXCELVBA
Dim sumberdata, CellAktif As Long
Me.TXTNOMOR.value = Me.TABELDATA.value
Me.TXTALAMAT.value = Me.TABELDATA.Column(6)
Sheet1.Select
sumberdata = Sheets("DATADOKUMEN").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("DATADOKUMEN").Range("A6:A" & sumberdata).Find(What:=Me.TXTNOMOR.value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CellAktif = ActiveCell.Row
Sheet1.Select
Exit Sub
EXCELVBA:
Call MsgBox("Harap klik pada data yang tersedia", vbCritical, "Data Salah")
End Sub
Private Sub TXTCARI_Change()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet1
Sheet2.Range("N6").value = "*" & Me.TXTCARI.value & "*"
Me.TABELDATA.value = ""
Me.TXTNOMOR.value = ""
Me.TXTALAMAT.value = ""
CariData.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("N5:N6"), Copytorange:=Sheet2.Range("A5:G5"), Unique:=False
Call HasilFilter
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub UserForm_Initialize()
Call AMBILDATA
Call Hitungrekap
Me.TXTFOLDER.value = Sheet1.Range("F2").value
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Cancel = True
End If
End Sub
