CODING APLIKASI

Private Sub ATURFOLDER_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("Folder").Value = SelectedFolder & "\"

Else

End If

End With

Me.FOLDERSIMPAN.Caption = Sheet1.Range("FOlder").Value

End Sub

Private Sub BACKUPDATA_Click()

Application.ScreenUpdating = False

If Me.EXCELFILE.Value = False _

And Me.PDFFILE.Value = False Then

Call MsgBox("Pilih jenis file Export", vbInformation, "Export Data")

Else

Select Case MsgBox("Data akan di export." _

& vbCrLf & "Apakah anda yakin?" _

, vbYesNo Or vbQuestion Or vbDefaultButton1, "Export Data")

Case vbNo

Exit Sub

Case vbYes

End Select
If Me.PDFFILE.Value = True Then

Sheet1.Range("NMOR").Value = Sheet1.Range("NMOR").Value + 1

Sheet1.Range("DATAEXPORT").Copy

Workbooks.Add

ActiveSheet.Paste

Application.CutCopyMode = False

Application.Visible = False

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

Me.FOLDERSIMPAN.Caption & " Export" & Me.TGLEXPORT.Value & " " &
Sheet1.Range("NMOR").Value & ".PDF", Quality:= _

xlQualityStandard, includeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Application.DisplayAlerts = False

ActiveWindow.Close

Application.ScreenUpdating = False

Call MsgBox("Data telah diexport", vbInformation, "Export Data")

End If

If Me.EXCELFILE.Value = True Then

Sheet1.Range("NMOR").Value = Sheet1.Range("NMOR").Value + 1

Sheet1.Range("DATAEXPORT").Copy

Workbooks.Add

ActiveSheet.Paste

Application.CutCopyMode = False

Application.Visible = False

ActiveWorkbook.SaveAs Filename:= _

Me.FOLDERSIMPAN.Caption & " Export" & Me.TGLEXPORT.Value & " " &
Sheet1.Range("NMOR").Value & ".xlsx", FileFormat:= _

xlOpenXMLWorkbook, CreateBackup:=False

ActiveWindow.Close

Application.ScreenUpdating = False

Call MsgBox("Data telah di Export", vbInformation, "Export Data")

End If
End If

End Sub

Private Sub BERSIHKAN_Click()

Me.ID.Value = ""

Me.NAMA.Value = ""

Me.JENISKELAMIN.Value = ""

Me.JABATAN.Value = ""

Me.TGL.Value = ""

Me.ALAMAT.Value = ""

Me.TELPN.Value = ""

Me.JENISIDENTITAS.Value = ""

Me.NOMORIDENTITAS.Value = ""

Me.CARINAMA.Value = ""

End Sub

Private Sub BUKAFILE_Click()

Application.ScreenUpdating = False

Dim Myfilename As Variant

Myfilename = Application.GetOpenFilename(FileFilter:="Excel File, *.xls*;*.xlsx*")

If Myfilename <> False Then

Workbooks.Open Filename:=Myfilename

Me.FILEOPEN.Value = ActiveWorkbook.FullName

Application.DisplayAlerts = False

ActiveWindow.Close

Else

Me.FILEOPEN.Value = ""

End If

Application.Visible = False

Application.ScreenUpdating = False
End Sub

Private Sub CARINAMA_Change()

On Error GoTo SALAH

Set Cari_Data = Sheet1

Cari_Data.Range("K2").Value = Me.CARINAMA.Value

Cari_Data.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _

Sheet1.Range("K1:K2"), CopyTorange:=Sheet1.Range("M1:U1"), Unique:=False

Me.TABELPEGAWAI.RowSource = Sheet1.Range("HASILCARI").Address(External:=True)

Exit Sub

SALAH:

Call MsgBox("Maaf, data yang dicari tidak ditemukan", vbInformation, "Cari Data")

End Sub

Private Sub EXCELFILE_Click()

If Me.EXCELFILE.Value = True Then

Me.BACKUPDATA.Enabled = True

Me.PDFFILE.Value = False

End If

End Sub

Private Sub MASUKKAN_Click()

Dim ImportErwin As Object

Dim wb As Workbook

If Me.FILEOPEN.Value = "" Then

Call MsgBox("File Data Import belum dipilih", vbInformation, "Import Data")

Else

Set wb = Application.Workbooks.Open(Me.FILEOPEN.Value)

Set ImportErwin = Sheet1.Range("A10000").End(xlUp)

Application.Visible = False

Workbooks.Open Filename:=Me.FILEOPEN.Value

Range("A2").Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Windows("APLIKASI EXPORT DATA.XLSM").Activate

ImportErwin.Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,

wb.Close

On Error Resume Next

TABELPEGAWAI.RowSource = "DATAPEGAWAI!A2:I" & Range("i" & Rows.Count).End(xlUp).Row

Call MsgBox("Data telah di Import", vbInformation, "Import Data")

End If

End Sub

Private Sub PDFFILE_Click()

If Me.PDFFILE.Value = True Then

Me.BACKUPDATA.Enabled = True

Me.EXCELFILE.Value = False

End If

End Sub

Private Sub SIMPAN_Click()

ThisWorkbook.Save

End Sub

Private Sub TAMBAH_Click()

Set Dpegawai = Sheet1.Range("A100000").End(xlUp)

If Me.ID.Value = "" _

Or Me.NAMA.Value = "" _

Or Me.JENISKELAMIN.Value = "" _

Or Me.JABATAN.Value = "" _

Or Me.TGL.Value = "" _

Or Me.ALAMAT.Value = "" _

Or Me.TELPN.Value = "" _

Or Me.JENISIDENTITAS.Value = "" _

Or Me.NOMORIDENTITAS.Value = "" Then

Call MsgBox("Harap isi data dengan lengkap", vbInformation, "Tambah Data")

Else

Dpegawai.Offset(1, 0).Value = Me.ID.Value

Dpegawai.Offset(1, 1).Value = Me.NAMA.Value

Dpegawai.Offset(1, 2).Value = Me.JENISKELAMIN.Value

Dpegawai.Offset(1, 3).Value = Me.JABATAN.Value

Dpegawai.Offset(1, 4).Value = Me.TGL.Value

Dpegawai.Offset(1, 5).Value = Me.ALAMAT.Value

Dpegawai.Offset(1, 6).Value = Me.TELPN.Value

Dpegawai.Offset(1, 7).Value = Me.JENISIDENTITAS.Value

Dpegawai.Offset(1, 8).Value = Me.NOMORIDENTITAS.Value

Call MsgBox("Data berhasil ditambah", vbInformation, "Tambah Data")

On Error Resume Next

TABELPEGAWAI.RowSource = "DATAPEGAWAI!A2:I" & Range("i" & Rows.Count).End(xlUp).Row

Me.ID.Value = ""

Me.NAMA.Value = ""

Me.JENISKELAMIN.Value = ""

Me.JABATAN.Value = ""

Me.TGL.Value = ""

Me.ALAMAT.Value = ""
Me.TELPN.Value = ""

Me.JENISIDENTITAS.Value = ""

Me.NOMORIDENTITAS.Value = ""

End If

End Sub

Private Sub TUTUP_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

ThisWorkbook.Save

ThisWorkbook.Close

End Sub

Private Sub UserForm_Initialize()

With JENISKELAMIN

.AddItem "Laki -Laki"

.AddItem "Perempuan"

End With

With JENISIDENTITAS

.AddItem "KTP"

.AddItem "SIM"

End With

On Error Resume Next

TABELPEGAWAI.RowSource = "DATAPEGAWAI!A2:I" & Range("i" & Rows.Count).End(xlUp).Row

Me.FOLDERSIMPAN.Caption = Sheet1.Range("FOlder").Value

Me.TGLEXPORT.Value = Date
Me.TGLEXPORT.Value = Format(Me.TGLEXPORT.Value, "DD MMMM YYYY")

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If CloseMode = 0 Then

Cancel = True

End If

End Sub