CODING FORM UTAMA
Option Explicit
Private Sub CMDCARI_Click()
If Me.OPTSURATMASUK.Value = True Then
Call CariSuratMasuk
End If
If Me.OPTSURATKELUAR.Value = True Then
Call CariSuratKeluar
End If
End Sub
Private Sub CMDCETAK_Click()
If Me.OPTSURATMASUK.Value = True Then
Call CetakSuratMasuk
End If
If Me.OPTSURATKELUAR.Value = True Then
Call CetakSuratKeluar
End If
End Sub
Private Sub CMDCLEAR_Click()
Select Case MsgBox("Anda menghapus semua informassi tentang Identitas Kantor" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus Informasi")
Case vbNo
Exit Sub
Case vbYes
End Select
Me.TXTNAMAKANTOR.Value = ""
Me.TXTALAMAT.Value = ""
Me.TXTTELPON.Value = ""
Me.TXTEMAIL.Value = ""
Me.TXTFOLDER.Value = ""
Me.TXTNAMAKANTOR.Enabled = True
Me.TXTALAMAT.Enabled = True
Me.TXTTELPON.Enabled = True
Me.TXTEMAIL.Enabled = True
Me.TXTFOLDER.Enabled = True
End Sub
Private Sub CMDDELETE1_Click()
If Me.OPTSURATMASUK.Value = True Then
Call HapusSuratMAsuk
End If
If Me.OPTSURATKELUAR.Value = True Then
Call HapusSuratKeluar
End If
End Sub
Private Sub CMDFOLDER_Click()
Dim SelectedFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select Folder"
.ButtonName = "Confirm"
If .Show = -1 Then
SelectedFolder = .SelectedItems(1)
Call MsgBox(SelectedFolder)
Sheet1.Range("D9").Value = SelectedFolder & "\"
Me.TXTFOLDER.Value = Sheet1.Range("D9").Value
Else
End If
End With
End Sub
Private Sub CMDHIDESHOW_Click()
If Me.CMDHIDESHOW.Caption = "Show" Then
Me.CMDHIDESHOW.Caption = "Hide"
Application.Visible = True
Else
Me.CMDHIDESHOW.Caption = "Show"
Application.Visible = False
End If
End Sub
Private Sub CMDOPEN_Click()
On Error GoTo EXCELVBA
ThisWorkbook.FollowHyperlink (Me.TABELSURAT.Column(8))
Exit Sub
EXCELVBA:
Call MsgBox("Pilih data surat terlebih dahulu. Atau file surat tidak ditemukan", vbInformation, "File
Surat")
End Sub
Private Sub CMDRESET2_Click()
Me.TABELSURAT.RowSource = ""
Me.OPTSURATKELUAR.Value = False
Me.OPTSURATMASUK.Value = False
Me.LABELSURAT.Caption = "TABEL DATA SURAT BELUM DIPILIH"
Me.TXTHAPUS.Value = ""
End Sub
Private Sub CMDSET_Click()
Sheet1.Range("D5").Value = Me.TXTNAMAKANTOR.Value
Sheet1.Range("D6").Value = Me.TXTALAMAT.Value
Sheet1.Range("D7").Value = Me.TXTTELPON.Value
Sheet1.Range("D8").Value = Me.TXTEMAIL.Value
Sheet1.Range("D9").Value = Me.TXTFOLDER.Value
Me.TXTNAMAKANTOR.Enabled = False
Me.TXTALAMAT.Enabled = False
Me.TXTTELPON.Enabled = False
Me.TXTEMAIL.Enabled = False
Me.TXTFOLDER.Enabled = False
End Sub
Private Sub CMDUPDATE1_Click()
If Me.OPTSURATMASUK.Value = True Then
Call EditSuratMasuk
End If
If Me.OPTSURATKELUAR.Value = True Then
Call EditSuratKeluar
End If
End Sub
Private Sub HapusSuratMAsuk()
Application.ScreenUpdating = False
Dim HapusData As Object
Me.TABELSURAT.Value = ""
If Me.TXTHAPUS.Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
'Membuat pesan konfirmasi hapus data
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
Sheet2.Select
Selection.EntireRow.Delete
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Call AmbilSuratMasuk
Sheet1.Select
End If
End Sub
Private Sub HapusSuratKeluar()
Application.ScreenUpdating = False
Dim HapusData As Object
Me.TABELSURAT.Value = ""
If Me.TXTHAPUS.Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
'Membuat pesan konfirmasi hapus data
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
Sheet3.Select
Selection.EntireRow.Delete
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Call AmbilSuratKeluar
Sheet1.Select
End If
End Sub
Private Sub EditSuratMasuk()
On Error GoTo EXCELVBA
Dim SUMBERUBAH, CELLAKTIF As String
With FORMSURATMASUK
.TXTKODE.Value = Me.TABELSURAT.Column(1)
.TXTTGLINPUT.Value = Format(Me.TABELSURAT.Column(2), "DD/MM/YYYY")
.TXTTGLSURATMASUK.Value = Format(Me.TABELSURAT.Column(3), "DD/MM/YYYY")
.TXTNOMORSURAT.Value = Me.TABELSURAT.Column(4)
.TXTPENGIRIM.Value = Me.TABELSURAT.Column(5)
.TXTPERIHAL.Value = Me.TABELSURAT.Column(6)
.TXTDITUJUKAN.Value = Me.TABELSURAT.Column(7)
.TXTFILEPDF.Value = Me.TABELSURAT.Column(8)
'menyeleksi baris data sesuai data di listbox
Sheet2.Select
SUMBERUBAH = Me.TABELSURAT.ListIndex + 5
Sheets("SURATMASUK").Range("A" & SUMBERUBAH).Activate
CELLAKTIF = ActiveCell.Row
Sheets("SURATMASUK").Range("A" & CELLAKTIF & ":i" & CELLAKTIF).Select
Sheet1.Select
FORMSURATMASUK.Show
End With
Exit Sub
EXCELVBA:
Call MsgBox("Maaf, mohon klik pada tabel data", vbInformation, "Pilih Data")
End Sub
Private Sub EditSuratKeluar()
On Error GoTo EXCELVBA
Dim SUMBERUBAH, CELLAKTIF As String
With FORMSURATKELUAR
.TXTKODE.Value = Me.TABELSURAT.Column(1)
.TXTTGLINPUT.Value = Format(Me.TABELSURAT.Column(2), "DD/MM/YYYY")
.TXTTGLSURATKELUAR.Value = Format(Me.TABELSURAT.Column(3), "DD/MM/YYYY")
.TXTNOMORSURAT.Value = Me.TABELSURAT.Column(4)
.TXTPENGIRIM.Value = Me.TABELSURAT.Column(5)
.TXTPERIHAL.Value = Me.TABELSURAT.Column(6)
.TXTDITUJUKAN.Value = Me.TABELSURAT.Column(7)
.TXTFILEPDF.Value = Me.TABELSURAT.Column(8)
'menyeleksi baris data sesuai data di listbox
Sheet3.Select
SUMBERUBAH = Me.TABELSURAT.ListIndex + 5
Sheets("SURATKELUAR").Range("A" & SUMBERUBAH).Activate
CELLAKTIF = ActiveCell.Row
Sheets("SURATKELUAR").Range("A" & CELLAKTIF & ":i" & CELLAKTIF).Select
Sheet1.Select
FORMSURATKELUAR.Show
End With
Exit Sub
EXCELVBA:
Call MsgBox("Maaf, mohon klik pada tabel data", vbInformation, "Pilih Data")
End Sub
Private Sub KELUAR_Click()
Select Case MsgBox("Anda akan keluar dari aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
Application.Visible = True
Sheet1.Select
Unload Me
End Sub
Private Sub LKELUAR_Click()
Select Case MsgBox("Anda akan keluar dari aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
Application.Visible = True
Sheet1.Select
Unload Me
End Sub
Private Sub LSIMPAN_Click()
ThisWorkbook.Save
End Sub
Private Sub LSURATKELUAR_Click()
FORMSURATKELUAR.Show
End Sub
Private Sub LSURATMASUK_Click()
FORMSURATMASUK.Show
End Sub
Private Sub MENU_Click()
If Me.PANELMENU.Width = 162 Then
Me.PANELMENU.Width = 48
Me.PANELINSTANSI.Left = Me.PANELMENU.Width + 2
Me.PANELDATA.Left = Me.PANELMENU.Width + Me.PANELINSTANSI.Width + 10
Me.PANELDATA.Width = Me.Width - Me.PANELINSTANSI.Width - Me.PANELMENU.Width - 30
Me.TABELSURAT.Width = Me.PANELDATA.Width - 10
Me.TXTTOTALDATA.Left = Me.TABELSURAT.Width - Me.TXTTOTALDATA.Width + 5
Me.LBTOTAL.Left = Me.TABELSURAT.Width - Me.TXTTOTALDATA.Width + 5
Me.OPTSURATKELUAR.Left = Me.TABELSURAT.Width - Me.OPTSURATKELUAR.Width + 5
Me.OPTSURATMASUK.Left = Me.TABELSURAT.Width - Me.OPTSURATMASUK.Width -
Me.OPTSURATKELUAR.Width + 5
Else
Me.PANELMENU.Width = 162
Me.PANELINSTANSI.Left = Me.PANELMENU.Width + 2
Me.PANELDATA.Left = Me.PANELMENU.Width + Me.PANELINSTANSI.Width + 10
Me.PANELDATA.Width = Me.Width - Me.PANELINSTANSI.Width - Me.PANELMENU.Width - 30
Me.TABELSURAT.Width = Me.PANELDATA.Width - 10
Me.TXTTOTALDATA.Left = Me.TABELSURAT.Width - Me.TXTTOTALDATA.Width + 5
Me.LBTOTAL.Left = Me.TABELSURAT.Width - Me.TXTTOTALDATA.Width + 5
Me.OPTSURATKELUAR.Left = Me.TABELSURAT.Width - Me.OPTSURATKELUAR.Width + 5
Me.OPTSURATMASUK.Left = Me.TABELSURAT.Width - Me.OPTSURATMASUK.Width -
Me.OPTSURATKELUAR.Width + 5
End If
End Sub
Private Sub OPTSURATKELUAR_Click()
Me.TXTHAPUS.Value = ""
Me.TABELSURAT.Value = ""
Call AmbilSuratKeluar
Me.LABELSURAT.Caption = "TABEL DATA SURAT KELUAR"
End Sub
Private Sub OPTSURATMASUK_Click()
Me.TXTHAPUS.Value = ""
Me.TABELSURAT.Value = ""
Call AmbilSuratMasuk
Me.LABELSURAT.Caption = "TABEL DATA SURAT MASUK"
End Sub
Private Sub SIMPAN_Click()
ThisWorkbook.Save
End Sub
Private Sub SURATKELUAR_Click()
FORMSURATKELUAR.Show
End Sub
Private Sub SURATMASUK_Click()
FORMSURATMASUK.Left = Me.Width + 20
FORMSURATMASUK.Show
End Sub
Private Sub TABELSURAT_Click()
Dim SUMBERUBAH As String
Dim CELLAKTIF As String
If Me.OPTSURATMASUK.Value = True Then
Application.ScreenUpdating = False
Me.TXTHAPUS.Value = Me.TABELSURAT.Column(1)
Sheet2.Select
SUMBERUBAH = Sheets("SURATMASUK").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("SURATMASUK").Range("B4:B" & SUMBERUBAH).Find(What:=Me.TXTHAPUS.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheet1.Select
End If
If Me.OPTSURATKELUAR.Value = True Then
Application.ScreenUpdating = False
Me.TXTHAPUS.Value = Me.TABELSURAT.Column(1)
Sheet3.Select
SUMBERUBAH = Sheets("SURATKELUAR").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("SURATKELUAR").Range("B4:B" & SUMBERUBAH).Find(What:=Me.TXTHAPUS.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheet1.Select
End If
End Sub
Private Sub UserForm_Initialize()
Me.PANELINSTANSI.Height = Me.Height
Me.PANELMENU.BackColor = RGB(24, 115, 190)
Me.PANELMENU.Width = 48
Me.PANELINSTANSI.Left = Me.PANELMENU.Width + 2
Me.PANELMENU.Height = Me.Height
Me.PANELDATA.Left = Me.PANELMENU.Width + Me.PANELINSTANSI.Width + 10
Me.PANELDATA.Width = Me.Width - Me.PANELINSTANSI.Width - Me.PANELMENU.Width - 30
Me.TABELSURAT.Width = Me.PANELDATA.Width - 10
Me.TXTTOTALDATA.Left = Me.TABELSURAT.Width - Me.TXTTOTALDATA.Width + 5
Me.LBTOTAL.Left = Me.TABELSURAT.Width - Me.TXTTOTALDATA.Width + 5
Me.OPTSURATKELUAR.Left = Me.TABELSURAT.Width - Me.OPTSURATKELUAR.Width + 5
Me.OPTSURATMASUK.Left = Me.TABELSURAT.Width - Me.OPTSURATMASUK.Width -
Me.OPTSURATKELUAR.Width + 5
Me.CMDHIDESHOW.Caption = "Show"
With CMBBERDASARKAN
.AddItem "Nomor Surat"
.AddItem "Pengirim"
.AddItem "Perihal"
.AddItem "Ditujukan"
.AddItem "Tanggal Surat"
End With
Call DataKantor
End Sub
Private Sub CariSuratMasuk()
On Error GoTo Salah
Dim iRow As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet2
Sheet5.Range("K5").Value = Me.CMBBERDASARKAN.Value
Sheet5.Range("K6").Value = Me.TXTKATAKUNCI.Value
Me.TABELSURAT.Value = ""
CARI_DATA.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet5.Range("K5:K6"), CopyToRange:=Sheet5.Range("A5:I5"), Unique:=False
iRow = Sheet5.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.TABELSURAT.RowSource = "CARIMASUK!A6:I" & iRow
Else
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End If
Me.TXTTOTALDATA.Value = Me.TABELSURAT.ListCount
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CariSuratKeluar()
On Error GoTo Salah
Dim iRow As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet3
Sheet6.Range("K5").Value = Me.CMBBERDASARKAN.Value
Sheet6.Range("K6").Value = Me.TXTKATAKUNCI.Value
Me.TABELSURAT.Value = ""
CARI_DATA.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet6.Range("K5:K6"), CopyToRange:=Sheet6.Range("A5:I5"), Unique:=False
iRow = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.TABELSURAT.RowSource = "CARIKELUAR!A6:I" & iRow
Else
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End If
Me.TXTTOTALDATA.Value = Me.TABELSURAT.ListCount
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CetakSuratMasuk()
If Me.TABELSURAT.RowSource = "" Then
Call MsgBox("Harap tampilkan data yang akan dicetak", vbInformation, "Cetak Surat Masuk")
Else
Select Case MsgBox("Anda akan mencetak surat masuk" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Surat Masuk")
Case vbNo
Exit Sub
Case vbYes
End Select
Unload Me
Sheet5.PrintPreview
FORMUTAMA.Show
End If
End Sub
Private Sub CetakSuratKeluar()
If Me.TABELSURAT.RowSource = "" Then
Call MsgBox("Harap tampilkan data yang akan dicetak", vbInformation, "Cetak Surat Keluar")
Else
Select Case MsgBox("Anda akan mencetak surat keluar" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Surat Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
Unload Me
Sheet6.PrintPreview
FORMUTAMA.Show
End If
End Sub
Private Sub AmbilSuratMasuk()
Dim DSURATMASUK As Long
Dim iRow As Long
iRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
DSURATMASUK = Application.WorksheetFunction.CountA(Sheet2.Range("B6:B90000"))
If DSURATMASUK = 0 Then
FORMUTAMA.TABELSURAT.RowSource = ""
Else
FORMUTAMA.TABELSURAT.RowSource = "SURATMASUK!A6:I" & iRow
End If
FORMUTAMA.TXTTOTALDATA.Value = FORMUTAMA.TABELSURAT.ListCount
Me.TSM.Caption = Sheet1.Range("D10").Value
Me.TSK.Caption = Sheet1.Range("D11").Value
Me.SMTI.Caption = Sheet1.Range("D12").Value
Me.SKTI.Caption = Sheet1.Range("D13").Value
Me.TOTALSURAT.Caption = Sheet1.Range("D14").Value
End Sub
Private Sub AmbilSuratKeluar()
Dim DSURATKELUAR As Long
Dim iRow As Long
iRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
DSURATKELUAR = Application.WorksheetFunction.CountA(Sheet3.Range("B6:B90000"))
If DSURATKELUAR = 0 Then
FORMUTAMA.TABELSURAT.RowSource = ""
Else
FORMUTAMA.TABELSURAT.RowSource = "SURATKELUAR!A6:I" & iRow
End If
FORMUTAMA.TXTTOTALDATA.Value = FORMUTAMA.TABELSURAT.ListCount
Me.TSM.Caption = Sheet1.Range("D10").Value
Me.TSK.Caption = Sheet1.Range("D11").Value
Me.SMTI.Caption = Sheet1.Range("D12").Value
Me.SKTI.Caption = Sheet1.Range("D13").Value
Me.TOTALSURAT.Caption = Sheet1.Range("D14").Value
End Sub
Private Sub DataKantor()
Me.TXTNAMAKANTOR.Value = Sheet1.Range("D5").Value
Me.TXTALAMAT.Value = Sheet1.Range("D6").Value
Me.TXTTELPON.Value = Sheet1.Range("D7").Value
Me.TXTEMAIL.Value = Sheet1.Range("D8").Value
Me.TXTFOLDER.Value = Sheet1.Range("D9").Value
Me.TXTNAMAKANTOR.Enabled = False
Me.TXTALAMAT.Enabled = False
Me.TXTTELPON.Enabled = False
Me.TXTEMAIL.Enabled = False
Me.TXTFOLDER.Enabled = False
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Cancel = True
End If
End Sub
