Menu

Selasa, 13 Desember 2016

Memasukan Data Textbox ke ListView dengan Tombol pada UserForm

Private Sub CmdTambahListviuw_Click()
Dim lvwItem As ListItem
With ListView1
Set lvwItem = .ListItems.Add(, , TextBox1.Value)
lvwItem.SubItems(1) = TextBox2.Value
lvwItem.SubItems(2) = TextBox3.Value
End With
End Sub

Dan untuk nampilkan semua data dalam ListView

Private Sub UserForm_Activate()
Dim wksSource As Worksheet
Dim rngData As Range
Dim rngCell As Range
Dim LstItem As ListItem
Dim RowCount As Long
Dim ColCount As Long
Dim i As Long
Dim j As Long

Set wksSource = Worksheets("Sheet1")
Set rngData = wksSource.Range("A1").CurrentRegion

For Each rngCell In rngData.Rows(1).Cells
Me.ListView1.ColumnHeaders.Add Text:=rngCell.Value, Width:=90
Next rngCell

RowCount = rngData.Rows.Count
ColCount = rngData.Columns.Count

For i = 2 To RowCount
Set LstItem = Me.ListView1.ListItems.Add(Text:=rngData(i, 1).Value)
For j = 2 To ColCount
LstItem.ListSubItems.Add Text:=rngData(i, j).Value
Next j
Next i
End Sub

Selasa, 15 November 2016

Memisahkan Duplikat dan data Unik dengan VBA Excel

Private Sub CommandButton1_Click()
i = 1
J = 0
k = 0
With ThisWorkbook.Sheets("Sheet2")
.[C:C,D:D,E:E].ClearContents
Do
If Application.WorksheetFunction.CountIf(.[C:C], .Cells(i, 1).Value) Then
J = J + 1
.Cells(J, 5).Value = .Cells(i, 1).Value
Else
k = k + 1
.Cells(k, 3).Value = .Cells(i, 1).Value
.Cells(k, 4).Value = Application.WorksheetFunction.CountIf(.[A:A], .Cells(k, 3).Value)
End If
i = i + 1
If .Cells(i, 1).Value = Empty Then Exit Do
Loop
End With
End Sub

Selasa, 02 Agustus 2016

Buat No urut diantara dua kolom dengna VBA ( UDF )

Terbilang dengan Rupiah ( UDF VBA Excel )

Public Function Terbilang(x As Currency) Dim triliun As Currency Dim milyar As Currency Dim juta As Currency Dim ribu As Currency Dim satu As Currency Dim sen As Currency Dim baca As String If x > 1000000000000# Then Terbilang = "< di atas satu triliun rupiah >" Exit Function End If 'Jika x adalah 0, maka dibaca sebagai 0 If x = 0 Then baca = angka(0, 1) Else 'Pisah masing-masing bagian untuk triliun, milyar, juta, ribu, rupiah, dan sen triliun = Int(x * 0.001 ^ 4) milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3) juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2) ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000) satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000) sen = Int((x - Int(x)) * 100) 'Baca bagian triliun dan ditambah akhiran triliun If triliun > 0 Then baca = ratus(triliun, 5) + "triliun " End If 'Baca bagian milyar dan ditambah akhiran milyar If milyar > 0 Then baca = ratus(milyar, 4) + "milyar " End If 'Baca bagian juta dan ditambah akhiran juta If juta > 0 Then baca = baca + ratus(juta, 3) + "juta " End If 'Baca bagian ribu dan ditambah akhiran ribu If ribu > 0 Then baca = baca + ratus(ribu, 2) + "ribu " End If 'Baca bagian rupiah dan ditambah akhiran rupiah If satu > 0 Then baca = baca + ratus(satu, 1) + "rupiah " Else baca = baca + "rupiah" End If 'Baca bagian sen dan ditambah akhiran sen If sen > 0 Then baca = baca + ratus(sen, 0) + "sen" End If End If Terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) End Function Function ratus(x As Currency, Posisi As Integer) As String Dim a100 As Integer, a10 As Integer, a1 As Integer Dim baca As String a100 = Int(x * 0.01) a10 = Int((x - a100 * 100) * 0.1) a1 = Int(x - a100 * 100 - a10 * 10) 'Baca Bagian Ratus If a100 = 1 Then baca = "Seratus " Else If a100 > 0 Then baca = angka(a100, Posisi) + "ratus " End If End If 'Baca Bagian Puluh dan Satuan If a10 = 1 Then baca = baca + angka(a10 * 10 + a1, Posisi) Else If a10 > 0 Then baca = baca + angka(a10, Posisi) + "puluh " End If If a1 > 0 Then baca = baca + angka(a1, Posisi) End If End If ratus = baca End Function Function angka(x As Integer, Posisi As Integer) Select Case x Case 0: angka = "Nol" Case 1: If Posisi <= 1 Or Posisi > 2 Then angka = "Satu " Else angka = "Se" End If Case 2: angka = "Dua " Case 3: angka = "Tiga " Case 4: angka = "Empat " Case 5: angka = "Lima " Case 6: angka = "Enam " Case 7: angka = "Tujuh " Case 8: angka = "Delapan " Case 9: angka = "Sembilan " Case 10: angka = "Sepuluh " Case 11: angka = "Sebelas " Case 12: angka = "Duabelas " Case 13: angka = "Tigabelas " Case 14: angka = "Empatbelas " Case 15: angka = "Limabelas " Case 16: angka = "Enambelas " Case 17: angka = "Tujuhbelas " Case 18: angka = "Delapanbelas " Case 19: angka = "Sembilanbelas " End Select End Function

Selasa, 09 Februari 2016

Menghapus Check Box pada vba excel di Form


Sub HapusCheckBox()
Dim Ctrl As Control
         For Each Ctrl In Me.Controls
       If TypeOf Ctrl Is MSForms.CheckBox Then: Ctrl.Value = False
      Next Ctrl
End Sub

Selasa, 02 Juni 2015

BUNGKUS DAN ISI

Hidup akan sangat melelahkan, sia-sia dan menjemukan bila pikiran hanya digunakan untuk mencari dan mengurus BUNGKUS-nya saja serta mengabaikan dan mengacuhkan ISI-nya.
Apa itu “BUNGKUS”-nya,
Dan apa itu “ISI”-nya?.
“Rumah yang indah” hanya bungkusnya.
“Keluarga bahagia” itu isinya.
“Pesta pernikahan” hanya bungkusnya.
“Sakinah, mawadah, warahmah” itu isinya.
“Ranjang mewah” hanya bungkusnya.
“Tidur nyenyak” itu isinya.
“Kekayaan” itu hanya bungkusnya.
“Hati yang bahagia” itu isinya.
“Makan enak” hanya bungkusnya.
“Gizi, energi, dan sehat” itu isinya.
“Kecantikan dan Ketampanan” hanya bungkusnya.
“Kepribadian dan hati” itu isinya.
“Bicara” itu hanya bungkusnya.
“Amal nyata” itu isinya.
“Buku” hanya bungkusnya.
“Pengetahuan” itu isinya.
“Jabatan” hanya bungkusnya.
“Pengabdian dan pelayanan” itu isinya.
“Kharisma” hanya bungkusnya.
“Ahlaqul karimah” itu isinya.
“Hidup di dunia” itu bungkusnya.
“Hidup sesudah mati” itu isinya.
Utamakanlah ISI-nya.
Namun rawatlah BUNGKUS-nya.
Jangan memandang rendah dan hina setiap BUNGKUS yang kita terima, karena berkah tak selalu datang dari BUNGKUS kain sutera melainkan juga datang dari BUNGKUS koran bekas.
Janganlah setengah mati mengejar apa yang tak bisa kita bawa mati

INFO YANG JARANG DIKETAHUI ORANG...

INFO YANG JARANG DIKETAHUI ORANG...

1. Nomor Darurat utk telepon genggam adalah 112. Jika anda sedang di daerah yg tdk menerima sinyal HP & perlu memanggil pertolongan, silahkan tekan 112 dan HP akan mencari otomatis network apapun yg ada utk menyambung kan nomor darurat bagi anda. Dan yg menarik, nomor 112 dpt ditekan biarpun keypad dlm kondisi di lock.
2. Kunci mobil anda ketinggalan di dlm mobil? Anda memakai kunci remote? Kalau kunci anda ketinggalan dlm mobil & remote cadangan nya ada di rumah, anda segera telpon orang rmh dgn HP, lalu dekatkan HP anda kurang lebih 30cm dari mobil & minta org rumah utk menekan tombol pembuka pd remote cadangan yg ada dirumah. Pd waktu menekan tombol pembuka remote, minta org rmh mendekatkan remotenya ke telepon cellular yg dipakainya.
3. Tips untuk menge-Check keabsahan mobil/motor anda. Ketik: contoh JATIM L8630NS (no plat mobilanda) Kirim ke 1717, nanti akan dpt balasan dari kepolisian mengenai data2 kendaraan anda, tips ini jg berguna untuk mengetahui data2 mobil bekas yg hendak anda akan beli.
4. Jika anda sedang terancam jiwanya krn dirampok/ditodong seseorang untuk mengeluarkan uang dari ATM, maka anda bisa minta pertolongan diam2 dgn memberikan nomor PIN scara terbalik, misal no asli PIN anda 1254 input 4521 di ATM maka mesin akan mengeluarkan uang anda juga tanda bahaya ke kantor polisi tanpa diketahui penodong tsb. Fasilitas ini tersedia di seluruh ATM tapi hanya sedikit org yg tahu (tolong disebarkan).
5.Lupa dng nomer sendiri ? Nggak usah missedcall org biar bisa tau no Sendiri?, nih ada cara cek no sendiri :
Axis : *2#
Xl : *123*7*2*1*1#
Smartfren : *995#
Simpati : *808#
Tri : *998#
Indosat : *123*30#

(SEMOGA BERMANFAAT).

Kamis, 26 Maret 2015

"Cukup Letakkan Gelasnya"

Seorang dosen mulai kuliah dengan memegang gelas berisi air, “Berapa berat gelas ini”, tanyanya pada mahasiswa sambil mengangkat gelas tersebut agak tinggi hingga seluruh mahasiswa bisa melihatnya.
“50 gr..100 gr..150 gr..entahlah” jawab seorang mahasiswa
“Well, kita takkan tahu jika tak menimbang” jawab sang dosen
“Pertanyaannya adalah, apa yang terjadi kalau saya angkat gelas ini selama 3 menit?” lanjutnya
“Takkan terjadi apa-apa” kali ini jawaban seorang mahasiswa terdengar sangat meyakinkan
Dosen melanjutkan “Kalau saya angkatnya sejam”
“Wah..tangan Anda akan keram Prof” jawab mahasisWA
“Bagaimana kalau seharian?” tanya sang dosen belum puas
“Entahlah. Mungkin tangan Anda mati rasa, otot terluka mungkin lumpuh. Dan harus dibawa kerumah sakit”. Seisi ruangan pun tertawa
“Betul sekali. Lantas apakah berat gelas ini akan berubah?”
“Tidak Prof”
“Lalu apa yang harus saya lakukan supaya hal-hal buruk di atas tak perlu terjadi?". 
Sang dosen terus bertanya
“Anda tak boleh lupa untuk meletakkan gelasnya”
“Persis ! Jangan angkat gelasnya terlalu lama”
HIKMAH : 
Masalah hidup layaknya gelas tadi, semakin lama kita bawa, semakin lama terbebani, semakin menderita pula.
Sebenarnya, bobot masalah itu takkan berubah sedikitpun. Hanya kita begitu lama memikirkannya. 
Benar, bahwa setiap masalah memang harus difikirkan untuk dicari solusinya, tapi yang terpenting adalah bagaimana kita mempercayakan semuanya HANYA kepada Allah. Bahwa di tanganNyalah segala kuasa. Dia yang mengatur alam semesta, menjaga keseimbangannya, sangat mustahil jika Dia lupa memberi jalan keluar.
 (Qs. Al Fath : 4)

Ketenangan hati adalah bukti kuatnya iman. Sebaliknya kita harus hati-hati saat dilanda terlbanyak kegelisahan, seolah masalah kita sangat besar, hingga merasa sebagai manusia paling menderita di muka bumi. Karena bisa jadi, saat itu iman kita sedang berada di titik nadhir hingga syaithan leluasa menggoda.
Hiduplah dengan semangat pemburu syurga, niscaya takkan ada masalah yang terlalu berat terasa...


SEMANGAT PAGI...
Salam SUKSES & BERKAH.
..

Rabu, 25 Maret 2015

Membuat tombol PDF dengan vb di excel

Insert CommandButton dan masukkan kode vb di bawah ini


Private Sub CommandButton1_Click()
PageSetup.PaperSize = xlPaperA4
NamaFile = Range("E94").Value
ActiveSheet.Range("A1:K160").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\PDF\" & NamaFile, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
    DoEvents
    MsgBox "Sudah di simpan di PDF"
End Sub

Membuat Gambar JPG di EXcel dengan vb

Cara buat gambar dari Range tertentu dengan macro sebagai berikut :
Insert button dan tulis kode berikut

Private Sub CommandButton1_Click()
                  'Set Rentang Anda ingin ekspor ke file
Dim rgExp As Range: Set rgExp = Worksheets("KARTU").Range("A89:K115")
                 'Salin kisaran sebagai gambar ke Clipboard
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
               '' 'Buat grafik kosong dengan ukuran yang tepat dari berbagai disalin
With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
Width:=rgExp.Width, Height:=rgExp.Height)
.Name = "ChartVolumeMetricsDevEXPORT"
.Activate
End With
                  '' 'Paste ke daerah grafik, ekspor ke file, menghapus grafik.
ActiveChart.Paste
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export ActiveWorkbook.Path & "\GAMBAR\KARTU.jpg"
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
End Sub

Mermbuat Print gak fungsi atau Error dengan Vb

Nah untuk membuat Print gak berfungsi bisa coba memasukkan scrib ini pada
Thisworkbook

Private Sub Workbook_BeforePrint(Cancel As Boolean) Cancel = True MsgBox "Di larang cetak File ini ", vbOKOnly, “Error” End Sub

Membuat Tombol close (X) worksheet gak berfungsi di Excel dengan VB

Nah untuk membuat Tombol close (X) worksheet gak berfungsi bisa coba memasukkan scrib ini pada 

Thisworkbook

Public myFlg As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Letakkan ini pada "ThisWorkbook"
If myFlg = True Then Exit Sub
Application.DisplayAlerts = False
Cancel = True
End Sub
Sub myClose()
myFlg = True
Application.DisplayAlerts = False
ActiveWindow.Close False
End Sub

Rabu, 25 Februari 2015

CARA BUAT CHEKBOX DI FORM EXCEL DAN TOMBOL SIMPANNYA


Private Sub CommandButton1_Click()
Dim str As String
Dim Hom As Long
Hom = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For Each ctrl In Frame1.Controls
If TypeOf ctrl Is MSForms.CheckBox Then
If ctrl.Value = True Then
Label1.Caption = Label1.Caption & ", " & ctrl.Caption
End If
End If
Next ctrl
Sheet1.Cells(Hom + 1, "A").Value = Right(Label1.Caption, Len(Label1.Caption) - 2)
Label1.Caption = ""
End Sub

Private Sub CommandButton2_Click()
Dim str As String
Dim Hom As Long
Hom = Sheet1.Range("B" & Rows.Count).End(xlUp).Row

If CheckBox1.Value = True Then
str = str & CheckBox1.Caption & ", "
End If
If CheckBox2.Value = True Then
str = str & CheckBox2.Caption & ", "
End If
If CheckBox3.Value = True Then
str = str & CheckBox3.Caption & ", "
End If
If CheckBox4.Value = True Then
str = str & CheckBox4.Caption & ", "
End If
If CheckBox5.Value = True Then
str = str & CheckBox5.Caption & ", "
End If
If CheckBox6.Value = True Then
str = str & CheckBox6.Caption & ", "
End If
If CheckBox7.Value = True Then
str = str & CheckBox7.Caption & ", "
End If
If CheckBox8.Value = True Then
str = str & CheckBox8.Caption & ", "
End If
If CheckBox9.Value = True Then
str = str & CheckBox9.Caption & ", "
End If
If CheckBox10.Value = True Then
str = str & CheckBox10.Caption & ", "
End If

str = Left(str, Len(str) - 2)
Sheet1.Cells(Hom + 1, "B").Value = str

End Sub

Kamis, 25 Desember 2014

MEMBUAT APLIKASI ARISAN DENGAN VB EXCEL

Cara penggunaanya iuran diisi terlebih dahulu dan setelah itu no di isi
Setelah No diisi dan di enter maka angsuran masuk ke kolom D dan bila sudah ada isinya di simpan di colom E
kode vb maronya adalah
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellTujuan As Object
Dim Kode As Variant
Dim KolomKosong As Object
Dim JmlhData As Double
Kode = Target.Value
On Error GoTo eror:
    If Not Intersect(Target, Range("N3")) Is Nothing Then
        If Target > 0 Then
            Set CellTujuan = Sheet1.Range("B:B").Find(What:=Kode, LookIn:=xlValues, LookAt:=xlWhole)
        Set KolomKosong = CellTujuan.Offset(0, 2)
        JmlhData = WorksheetFunction.CountA(Range(KolomKosong, KolomKosong.End(xlToRight)))
            If KolomKosong <> "" Then
            Set KolomKosong = CellTujuan.Offset(0, 2 + JmlhData)
            End If
        KolomKosong.Value = Range("K8").Value
        End If
        End If
Exit Sub
eror:
MsgBox "Data Tidak Ditemukan"
End Sub
DOWLOAD contoh filenya

Minggu, 30 November 2014

BUAT TRANSAKSI SIMPAN PINJAM DENGAN VBA EXCEL

Namai TexkBox dengan kode pada perintah batal
Contoh txtNIK.Value = "" berarti textboxnya txtNIK
Untuk perintah BATAL kode VBAnya 


Private Sub cmdBatal_Click()
txtNIK.Value = ""
cboRST.Value = ""
TxtNOANG.Value = ""
TxtTGA.Value = ""
txtNM.Value = ""
txtTMP.Value = ""
txtTGL.Value = ""
txtJR.Value = ""
txtKC.Value = ""
TxtANG.Value = ""
TxtJAM.Value = ""
cboBANK.Value = ""
txtNOBANK.Value = ""
TxtBAYARDI.Value = ""
txtKJ.Value = ""
txtTGLP.Value = ""
TxtPINJ.Value = ""
optLAMA.Value = ""
optBARU.Value = ""
optDINAS.Value = ""
optPENSIUNAN.Value = ""
optUMUM.Value = ""
optATM.Value = ""
TxtKE.Value = ""
txtHP.Value = ""
Cbobayar.Value = ""
TxtGaji.Value = ""
JMGAJI.Value = ""
End Sub

Untuk perintah ANGGOTA BARU
Private Sub cmdInput_Click()
On Error Resume Next
Dim Filter As String, Title As String, FileX As String
Dim CellTujuan As Long
If txtNIK.Value = "" Then
    MsgBox "NOMOR masih kosong", vbOKOnly
    txtNIK.SetFocus
    Exit Sub

ElseIf txtNM.Value = "" Then
    MsgBox "NAMA masih kosong", vbOKOnly
    txtNM.SetFocus
    Exit Sub
   
    Exit Sub
End If


With Worksheets("DATA")
CellTujuan = .Cells(.Rows.Count, "D"). _
End(xlUp).Offset(0, 1).Row
'--- data input
Worksheets("DATA").Cells(CellTujuan + 1, 1).Value = CellTujuan
Worksheets("DATA").Cells(CellTujuan + 1, 2).Value = (cboRST.Value + TxtNOANG.Value)
Worksheets("DATA").Cells(CellTujuan + 1, 3).Value = txtNIK.Value
Worksheets("DATA").Cells(CellTujuan + 1, 4).Value = cboRST.Value
Worksheets("DATA").Cells(CellTujuan + 1, 5).Value = TxtNOANG.Value
Worksheets("DATA").Cells(CellTujuan + 1, 6).Value = TxtTGA.Value
Worksheets("DATA").Cells(CellTujuan + 1, 7).Value = txtNM.Value
Worksheets("DATA").Cells(CellTujuan + 1, 8).Value = txtTMP.Value
Worksheets("DATA").Cells(CellTujuan + 1, 9).Value = txtTGL.Value
Worksheets("DATA").Cells(CellTujuan + 1, 10).Value = txtJR.Value
Worksheets("DATA").Cells(CellTujuan + 1, 11).Value = txtKC.Value
Worksheets("DATA").Cells(CellTujuan + 1, 12).Value = TxtANG.Value
Worksheets("DATA").Cells(CellTujuan + 1, 13).Value = TxtJAM.Value
Worksheets("DATA").Cells(CellTujuan + 1, 14).Value = cboBANK.Value
Worksheets("DATA").Cells(CellTujuan + 1, 15).Value = txtNOBANK.Value
Worksheets("DATA").Cells(CellTujuan + 1, 16).Value = TxtBAYARDI.Value
Worksheets("DATA").Cells(CellTujuan + 1, 17).Value = txtKJ.Value
Worksheets("DATA").Cells(CellTujuan + 1, 18).Value = txtTGLP.Value
Worksheets("DATA").Cells(CellTujuan + 1, 19).Value = TxtPINJ.Value
If optLAMA = True Then
Worksheets("DATA").Cells(CellTujuan + 1, 20).Value = "LAMA"
ElseIf optBARU = True Then
Worksheets("DATA").Cells(CellTujuan + 1, 20).Value = "BARU"
End If
If optDINAS = True Then
Worksheets("DATA").Cells(CellTujuan + 1, 21).Value = "DINAS"
ElseIf optPENSIUNAN = True Then
Worksheets("DATA").Cells(CellTujuan + 1, 21).Value = "PENSIUNAN"
ElseIf optUMUM = True Then
Worksheets("DATA").Cells(CellTujuan + 1, 21).Value = "UMUM"
ElseIf optATM = True Then
Worksheets("DATA").Cells(CellTujuan + 1, 21).Value = "ATM"
End If
Worksheets("DATA").Cells(CellTujuan + 1, 22).Value = TxtKE.Value
Worksheets("DATA").Cells(CellTujuan + 1, 23).Value = txtHP.Value
Worksheets("DATA").Cells(CellTujuan + 1, 24).Value = Cbobayar.Value
Worksheets("DATA").Cells(CellTujuan + 1, 25).Value = TxtGaji.Value
Worksheets("DATA").Cells(CellTujuan + 1, 26).Value = "=DATEDIF(RC[-17],NOW(),""y"")&"" ""&""Tahun"""
Worksheets("DATA").Cells(CellTujuan + 1, 27).Value = JMGAJI.Value
End With


With Worksheets("BLANGKO")
Worksheets("BLANGKO").Cells(2, 1) = txtNM.Value
Worksheets("BLANGKO").Cells(2, 2) = txtTMP.Value
Worksheets("BLANGKO").Cells(2, 3) = TxtTGA.Value
Worksheets("BLANGKO").Cells(2, 4) = txtKJ.Value
Worksheets("BLANGKO").Cells(2, 5) = txtJR.Value
Worksheets("BLANGKO").Cells(2, 6) = txtKC.Value
Worksheets("BLANGKO").Cells(2, 7) = TxtPINJ.Value
Worksheets("BLANGKO").Cells(2, 8) = "=TERBILANG(RC[-1])"
Worksheets("BLANGKO").Cells(2, 9) = cboBANK.Value
Worksheets("BLANGKO").Cells(2, 10) = txtNOBANK.Value
Worksheets("BLANGKO").Cells(2, 11) = cboRST.Value
Worksheets("BLANGKO").Cells(2, 12) = TxtANG.Value
Worksheets("BLANGKO").Cells(2, 13) = TxtJAM.Value
Worksheets("BLANGKO").Cells(2, 14) = txtTGLP.Value
Worksheets("BLANGKO").Cells(2, 15) = (TxtPINJ.Value / 12)
Worksheets("BLANGKO").Cells(2, 16) = "=TERBILANG(RC[-1])"
Worksheets("BLANGKO").Cells(2, 17) = "=RC[-3]+30"
Worksheets("BLANGKO").Cells(2, 18) = TxtNOANG.Value
End With

With Worksheets("BERKAS")
Worksheets("BERKAS").Cells(3, 11) = TxtNOANG.Value
Worksheets("BERKAS").Cells(11, 11) = cboRST.Value
Worksheets("BERKAS").Cells(7, 2) = TxtPINJ.Value
Worksheets("BERKAS").Cells(10, 5) = txtNM.Value
Worksheets("BERKAS").Cells(11, 3) = txtJR.Value
Worksheets("BERKAS").Cells(12, 3) = txtKC.Value
Worksheets("BERKAS").Cells(13, 5) = TxtANG.Value
Worksheets("BERKAS").Cells(14, 5) = TxtJAM.Value
Worksheets("BERKAS").Cells(15, 5) = (cboBANK.Value + txtNOBANK.Value)
End With

With Worksheets("KARTU")
Worksheets("KARTU").Cells(2, 3) = TxtPINJ.Value
Worksheets("KARTU").Cells(3, 1) = "=TERBILANG(R[-1]C[2])"
Worksheets("KARTU").Cells(7, 5) = txtNM.Value
Worksheets("KARTU").Cells(8, 5) = txtTMP.Value
Worksheets("KARTU").Cells(8, 6) = txtTGL.Value
Worksheets("KARTU").Cells(8, 7) = "=DATEDIF(RC[-1],NOW(),""y"")&"" ""&""Tahun"""
Worksheets("KARTU").Cells(9, 5) = txtJR.Value
Worksheets("KARTU").Cells(10, 5) = txtKC.Value
Worksheets("KARTU").Cells(12, 5) = cboRST.Value
Worksheets("KARTU").Cells(7, 10) = TxtNOANG.Value
Worksheets("KARTU").Cells(9, 10) = TxtBAYARDI.Value
Worksheets("KARTU").Cells(10, 10) = Cbobayar.Value
Worksheets("KARTU").Cells(12, 10) = TxtANG.Value
Worksheets("KARTU").Cells(13, 9) = TxtJAM.Value
Worksheets("KARTU").Cells(13, 7) = txtNOBANK.Value
Worksheets("KARTU").Cells(16, 2) = txtTGLP.Value
Worksheets("KARTU").Cells(16, 8) = TxtPINJ.Value
Worksheets("KARTU").Cells(11, 6) = txtKJ.Value
Application.ScreenUpdating = False
NamaFile = (cboRST.Value + TxtNOANG.Value + " " + txtNM.Value)
FileX = ActiveWorkbook.Path & "\Photo\" & NamaFile & ".jpg"
Worksheets("KARTU").Image1.Picture = LoadPicture(FileX)
Application.ScreenUpdating = True
End With

With Worksheets("BALEK KARTU")
Worksheets("BALEK KARTU").Cells(9, 3) = JMGAJI.Value
Worksheets("BALEK KARTU").Cells(10, 2) = "=terbilang(R[-1]C[1])"
Worksheets("BALEK KARTU").Cells(18, 2) = txtNM.Value
Worksheets("BALEK KARTU").Cells(19, 3) = txtTGLP.Value
End With

With Worksheets("KWITANSI")
Worksheets("KWITANSI").Cells(2, 5) = cboRST.Value
Worksheets("KWITANSI").Cells(23, 5) = cboRST.Value
Worksheets("KWITANSI").Cells(2, 6) = TxtNOANG.Value
Worksheets("KWITANSI").Cells(23, 6) = TxtNOANG.Value
Worksheets("KWITANSI").Cells(12, 10) = txtTGLP.Value
Worksheets("KWITANSI").Cells(35, 10) = txtTGLP.Value
Worksheets("KWITANSI").Cells(18, 14) = txtNM.Value
Worksheets("KWITANSI").Cells(18, 14) = txtNM.Value
Worksheets("KWITANSI").Cells(6, 8) = "=TERBILANG(R[12]C[-3])"
Worksheets("KWITANSI").Cells(27, 8) = "=TERBILANG(R[12]C[-3])"
Worksheets("KWITANSI").Cells(18, 5) = TxtPINJ.Value
Worksheets("KWITANSI").Cells(39, 5) = TxtPINJ.Value
End With

Select Case cboRST.Value
Case "ANGGREK"
With Worksheets("ANGGREK")
CellTujuan = .Cells(.Rows.Count, "D"). _
End(xlUp).Offset(0, 1).Row
'--- data input
Worksheets("ANGGREK").Cells(CellTujuan + 1, 1).Value = CellTujuan - 1
Worksheets("ANGGREK").Cells(CellTujuan + 1, 2).Value = txtTGLP.Value
Worksheets("ANGGREK").Cells(CellTujuan + 1, 3).Value = (Day(txtTGLP.Value))
Worksheets("ANGGREK").Cells(CellTujuan + 1, 4).Value = TxtNOANG.Value
Worksheets("ANGGREK").Cells(CellTujuan + 1, 5).Value = txtNM.Value
If optDINAS = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 6).Value = 1
ElseIf optPENSIUNAN = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 7).Value = 1
ElseIf optUMUM = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 8).Value = 1
ElseIf optATM = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 8).Value = 1
End If
If optLAMA = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 10).Value = 1
ElseIf optBARU = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 11).Value = 1
End If
If optLAMA = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 12).Value = TxtPINJ.Value
ElseIf optBARU = True Then
Worksheets("ANGGREK").Cells(CellTujuan + 1, 13).Value = TxtPINJ.Value
End If
Worksheets("ANGGREK").Cells(CellTujuan + 1, 14).Value = (TxtPINJ.Value * 3 / 100)
Worksheets("ANGGREK").Cells(CellTujuan + 1, 15).Value = "=IF(RC[-4]=1,5000,"""")"
Worksheets("ANGGREK").Cells(CellTujuan + 1, 16).Value = "=SUM(RC[-4]:RC[-3])-SUM(RC[-2]:RC[-1])"
End With

Case "MAWAR"
With Worksheets("MAWAR")
CellTujuan = .Cells(.Rows.Count, "D"). _
End(xlUp).Offset(0, 1).Row
'--- data input
Worksheets("MAWAR").Cells(CellTujuan + 1, 1).Value = CellTujuan - 1
Worksheets("MAWAR").Cells(CellTujuan + 1, 2).Value = txtTGLP.Value
Worksheets("MAWAR").Cells(CellTujuan + 1, 3).Value = (Day(txtTGLP.Value))
Worksheets("MAWAR").Cells(CellTujuan + 1, 4).Value = TxtNOANG.Value
Worksheets("MAWAR").Cells(CellTujuan + 1, 5).Value = txtNM.Value
If optDINAS = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 6).Value = 1
ElseIf optPENSIUNAN = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 7).Value = 1
ElseIf optUMUM = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 8).Value = 1
ElseIf optATM = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 8).Value = 1
End If
If optLAMA = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 10).Value = 1
ElseIf optBARU = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 11).Value = 1
End If
If optLAMA = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 12).Value = TxtPINJ.Value
ElseIf optBARU = True Then
Worksheets("MAWAR").Cells(CellTujuan + 1, 13).Value = TxtPINJ.Value
End If
Worksheets("MAWAR").Cells(CellTujuan + 1, 14).Value = (TxtPINJ.Value * 3 / 100)
Worksheets("MAWAR").Cells(CellTujuan + 1, 15).Value = "=IF(RC[-4]=1,5000,"""")"
Worksheets("MAWAR").Cells(CellTujuan + 1, 16).Value = "=SUM(RC[-4]:RC[-3])-SUM(RC[-2]:RC[-1])"
End With

Case ("TERATAI")
With Worksheets("TERATAI")
CellTujuan = .Cells(.Rows.Count, "D"). _
End(xlUp).Offset(0, 1).Row
'--- data input
Worksheets("TERATAI").Cells(CellTujuan + 1, 1).Value = CellTujuan - 1
Worksheets("TERATAI").Cells(CellTujuan + 1, 2).Value = txtTGLP.Value
Worksheets("TERATAI").Cells(CellTujuan + 1, 3).Value = (Day(txtTGLP.Value))
Worksheets("TERATAI").Cells(CellTujuan + 1, 4).Value = TxtNOANG.Value
Worksheets("TERATAI").Cells(CellTujuan + 1, 5).Value = txtNM.Value
If optDINAS = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 6).Value = 1
ElseIf optPENSIUNAN = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 7).Value = 1
ElseIf optUMUM = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 8).Value = 1
ElseIf optATM = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 8).Value = 1
End If
If optLAMA = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 10).Value = 1
ElseIf optBARU = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 11).Value = 1
End If
If optLAMA = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 12).Value = TxtPINJ.Value
ElseIf optBARU = True Then
Worksheets("TERATAI").Cells(CellTujuan + 1, 13).Value = TxtPINJ.Value
End If
Worksheets("TERATAI").Cells(CellTujuan + 1, 14).Value = (TxtPINJ.Value * 3 / 100)
Worksheets("TERATAI").Cells(CellTujuan + 1, 15).Value = "=IF(RC[-4]=1,5000,"""")"
Worksheets("TERATAI").Cells(CellTujuan + 1, 16).Value = "=SUM(RC[-4]:RC[-3])-SUM(RC[-2]:RC[-1])"
End With
End Select

txtNIK.Value = ""
cboRST.Value = ""
TxtNOANG.Value = ""
TxtTGA.Value = ""
txtNM.Value = ""
txtTMP.Value = ""
txtTGL.Value = ""
txtJR.Value = ""
txtKC.Value = ""
TxtANG.Value = ""
TxtJAM.Value = ""
cboBANK.Value = ""
txtNOBANK.Value = ""
TxtBAYARDI.Value = ""
txtKJ.Value = ""
txtTGLP.Value = ""
TxtPINJ.Value = ""
optLAMA.Value = ""
optBARU.Value = ""
optDINAS.Value = ""
optPENSIUNAN.Value = ""
optUMUM.Value = ""
optATM.Value = ""
TxtKE.Value = ""
txtHP.Value = ""
Cbobayar.Value = ""
TxtGaji.Value = ""
JMGAJI.Value = ""
MsgBox "Data sudah disimpan", vbOKOnly
End Sub

UNTUK TOMBOL CARI
 Private Sub CMDCARI_Click()
On Error Resume Next
Dim Filter As String, Title As String, FileX As String
Dim Kode
Dim CellTujuan As Range
Kode = (cboRST.Value + TxtNOANG.Value)
Set CellTujuan = Worksheets("DATA").Range("B:B").Find(What:=Kode, LookIn:=xlValues, LookAt:=xlWhole)
If Not CellTujuan Is Nothing Then
txtNIK.Value = Worksheets("DATA").Cells(CellTujuan.Row, 3)
cboRST.Value = Worksheets("DATA").Cells(CellTujuan.Row, 4)
TxtNOANG.Value = Worksheets("DATA").Cells(CellTujuan.Row, 5)
TxtTGA.Value = Worksheets("DATA").Cells(CellTujuan.Row, 6)
txtNM.Value = Worksheets("DATA").Cells(CellTujuan.Row, 7)
txtTMP.Value = Worksheets("DATA").Cells(CellTujuan.Row, 8)
txtTGL.Value = Worksheets("DATA").Cells(CellTujuan.Row, 9)
txtJR.Value = Worksheets("DATA").Cells(CellTujuan.Row, 10)
txtKC.Value = Worksheets("DATA").Cells(CellTujuan.Row, 11)
TxtANG.Value = Worksheets("DATA").Cells(CellTujuan.Row, 12)
TxtJAM.Value = Worksheets("DATA").Cells(CellTujuan.Row, 13)
cboBANK.Value = Worksheets("DATA").Cells(CellTujuan.Row, 14)
txtNOBANK.Value = Worksheets("DATA").Cells(CellTujuan.Row, 15)
TxtBAYARDI.Value = Worksheets("DATA").Cells(CellTujuan.Row, 16)
txtKJ.Value = Worksheets("DATA").Cells(CellTujuan.Row, 17)
txtTGLP.Value = Worksheets("DATA").Cells(CellTujuan.Row, 18)
TxtPINJ.Value = Worksheets("DATA").Cells(CellTujuan.Row, 19)
If Worksheets("DATA").Cells(CellTujuan.Row, 20) = "LAMA" Then
optLAMA.Value = True
ElseIf Worksheets("DATA").Cells(CellTujuan.Row, 20) = "BARU" Then
optBARU.Value = True
End If
If Worksheets("DATA").Cells(CellTujuan.Row, 21) = "DINAS" Then
optDINAS.Value = True
ElseIf Worksheets("DATA").Cells(CellTujuan.Row, 21) = "PENSIUNAN" Then
optPENSIUNAN.Value = True
ElseIf Worksheets("DATA").Cells(CellTujuan.Row, 21) = "UMUM" Then
optUMUM.Value = True
ElseIf Worksheets("DATA").Cells(CellTujuan.Row, 21) = "ATM" Then
optATM.Value = True
End If
TxtKE.Value = Worksheets("DATA").Cells(CellTujuan.Row, 22)
txtHP.Value = Worksheets("DATA").Cells(CellTujuan.Row, 23)
Cbobayar.Value = Worksheets("DATA").Cells(CellTujuan.Row, 24)
TxtGaji.Value = Worksheets("DATA").Cells(CellTujuan.Row, 25)
JMGAJI.Value = Worksheets("DATA").Cells(CellTujuan.Row, 27)
Else: MsgBox "Tidak Ada Hasil !"
End If
Application.ScreenUpdating = False
NamaFile = (cboRST.Value + TxtNOANG.Value + " " + txtNM.Value)
FileX = ActiveWorkbook.Path & "\Photo\" & NamaFile & ".jpg"
FOTO.Picture = LoadPicture(FileX)
   FOTO.Height = TRANSAKSI.Height - 405 '+ Image1.Height
  FOTO.Width = TRANSAKSI.Width - 655 '+ Image1.Height
   FOTO.Top = 36
   FOTO.Left = 606
Application.ScreenUpdating = True
End Sub
UNTUK ANGGOTA LAMA
Private Sub ANGGOTALAMA_Click()
On Error Resume Next
Dim Filter As String, Title As String, FileX As String
Dim Kode
Dim TujuanData As Range
Kode = (cboRST.Text + TxtNOANG.Text)
Set TujuanData = Sheets("DATA").Range("B:B").Find(What:=Kode, LookIn:=xlValues, LookAt:=xlWhole)
If Not TujuanData Is Nothing Then
Worksheets("DATA").Cells(TujuanData.Row, 3).Value = txtNIK.Value
Worksheets("DATA").Cells(TujuanData.Row, 4).Value = cboRST.Value
Worksheets("DATA").Cells(TujuanData.Row, 5).Value = TxtNOANG.Value
Worksheets("DATA").Cells(TujuanData.Row, 6).Value = TxtTGA.Value
Worksheets("DATA").Cells(TujuanData.Row, 7).Value = txtNM.Value
Worksheets("DATA").Cells(TujuanData.Row, 8).Value = txtTMP.Value
Worksheets("DATA").Cells(TujuanData.Row, 9).Value = txtTGL.Value
Worksheets("DATA").Cells(TujuanData.Row, 10).Value = txtJR.Value
Worksheets("DATA").Cells(TujuanData.Row, 11).Value = txtKC.Value
Worksheets("DATA").Cells(TujuanData.Row, 12).Value = TxtANG.Value
Worksheets("DATA").Cells(TujuanData.Row, 13).Value = TxtJAM.Value
Worksheets("DATA").Cells(TujuanData.Row, 14).Value = cboBANK.Value
Worksheets("DATA").Cells(TujuanData.Row, 15).Value = txtNOBANK.Value
Worksheets("DATA").Cells(TujuanData.Row, 16).Value = TxtBAYARDI.Value
Worksheets("DATA").Cells(TujuanData.Row, 17).Value = txtKJ.Value
Worksheets("DATA").Cells(TujuanData.Row, 18).Value = txtTGLP.Value
Worksheets("DATA").Cells(TujuanData.Row, 19).Value = TxtPINJ.Value
If optLAMA = True Then
Worksheets("DATA").Cells(TujuanData.Row, 20).Value = "LAMA"
ElseIf optBARU = True Then
Worksheets("DATA").Cells(TujuanData.Row, 20).Value = "BARU"
End If
If optDINAS = True Then
Worksheets("DATA").Cells(TujuanData.Row, 21).Value = "DINAS"
ElseIf optPENSIUNAN = True Then
Worksheets("DATA").Cells(TujuanData.Row, 21).Value = "PENSIUNAN"
ElseIf optUMUM = True Then
Worksheets("DATA").Cells(TujuanData.Row, 21).Value = "UMUM"
ElseIf optATM = True Then
Worksheets("DATA").Cells(TujuanData.Row, 21).Value = "ATM"
End If
Worksheets("DATA").Cells(TujuanData.Row, 22).Value = TxtKE.Value
Worksheets("DATA").Cells(TujuanData.Row, 23).Value = txtHP.Value
Worksheets("DATA").Cells(TujuanData.Row, 24).Value = Cbobayar.Value
Worksheets("DATA").Cells(TujuanData.Row, 25).Value = TxtGaji.Value
Worksheets("DATA").Cells(TujuanData.Row, 26).Value = "=DATEDIF(RC[-17],NOW(),""y"")&"" ""&""Tahun"""
Worksheets("DATA").Cells(TujuanData.Row, 27).Value = JMGAJI.Value
End If

With Worksheets("BLANGKO")
Worksheets("BLANGKO").Cells(2, 1) = txtNM.Value
Worksheets("BLANGKO").Cells(2, 2) = txtTMP.Value
Worksheets("BLANGKO").Cells(2, 3) = TxtTGA.Value
Worksheets("BLANGKO").Cells(2, 4) = txtKJ.Value
Worksheets("BLANGKO").Cells(2, 5) = txtJR.Value
Worksheets("BLANGKO").Cells(2, 6) = txtKC.Value
Worksheets("BLANGKO").Cells(2, 7) = TxtPINJ.Value
Worksheets("BLANGKO").Cells(2, 8) = "=TERBILANG(RC[-1])"
Worksheets("BLANGKO").Cells(2, 9) = cboBANK.Value
Worksheets("BLANGKO").Cells(2, 10) = txtNOBANK.Value
Worksheets("BLANGKO").Cells(2, 11) = cboRST.Value
Worksheets("BLANGKO").Cells(2, 12) = TxtANG.Value
Worksheets("BLANGKO").Cells(2, 13) = TxtJAM.Value
Worksheets("BLANGKO").Cells(2, 14) = txtTGLP.Value
Worksheets("BLANGKO").Cells(2, 15) = (TxtPINJ.Value / 12)
Worksheets("BLANGKO").Cells(2, 16) = "=TERBILANG(RC[-1])"
Worksheets("BLANGKO").Cells(2, 17) = "=RC[-3]+30"
Worksheets("BLANGKO").Cells(2, 18) = TxtNOANG.Value
End With


With Worksheets("BERKAS")
Worksheets("BERKAS").Cells(3, 11) = TxtNOANG.Value
Worksheets("BERKAS").Cells(11, 11) = cboRST.Value
Worksheets("BERKAS").Cells(7, 2) = txtTGLP.Value
Worksheets("BERKAS").Cells(10, 5) = txtNM.Value
Worksheets("BERKAS").Cells(11, 3) = txtJR.Value
Worksheets("BERKAS").Cells(12, 3) = txtKC.Value
Worksheets("BERKAS").Cells(13, 5) = TxtANG.Value
Worksheets("BERKAS").Cells(14, 5) = TxtJAM.Value
Worksheets("BERKAS").Cells(15, 5) = (cboBANK.Value + txtNOBANK.Value)
End With

With Worksheets("KARTU")
Worksheets("KARTU").Cells(2, 3) = TxtPINJ.Value
Worksheets("KARTU").Cells(3, 1) = "=TERBILANG(R[-1]C[2])"
Worksheets("KARTU").Cells(7, 5) = txtNM.Value
Worksheets("KARTU").Cells(8, 5) = txtTMP.Value
Worksheets("KARTU").Cells(8, 6) = txtTGL.Value
Worksheets("KARTU").Cells(8, 7) = "=DATEDIF(RC[-1],NOW(),""y"")&"" ""&""Tahun"""
Worksheets("KARTU").Cells(9, 5) = txtJR.Value
Worksheets("KARTU").Cells(10, 5) = txtKC.Value
Worksheets("KARTU").Cells(12, 5) = cboRST.Value
Worksheets("KARTU").Cells(7, 10) = TxtNOANG.Value
Worksheets("KARTU").Cells(9, 10) = TxtBAYARDI.Value
Worksheets("KARTU").Cells(10, 10) = Cbobayar.Value
Worksheets("KARTU").Cells(12, 10) = TxtANG.Value
Worksheets("KARTU").Cells(13, 9) = TxtJAM.Value
Worksheets("KARTU").Cells(13, 7) = txtNOBANK.Value
Worksheets("KARTU").Cells(16, 2) = txtTGLP.Value
Worksheets("KARTU").Cells(16, 8) = TxtPINJ.Value
Worksheets("KARTU").Cells(11, 6) = txtKJ.Value
Application.ScreenUpdating = False
NamaFile = (cboRST.Value + TxtNOANG.Value + " " + txtNM.Value)
FileX = ActiveWorkbook.Path & "\Photo\" & NamaFile & ".jpg"
Worksheets("KARTU").Image1.Picture = LoadPicture(FileX)
Application.ScreenUpdating = True
End With

With Worksheets("BALEK KARTU")
Worksheets("BALEK KARTU").Cells(9, 3) = JMGAJI.Value
Worksheets("BALEK KARTU").Cells(10, 2) = "=terbilang(R[-1]C[1])"
Worksheets("BALEK KARTU").Cells(18, 2) = txtNM.Value
Worksheets("BALEK KARTU").Cells(19, 3) = txtTGLP.Value
End With

With Worksheets("KWITANSI")
Worksheets("KWITANSI").Cells(2, 5) = cboRST.Value
Worksheets("KWITANSI").Cells(23, 5) = cboRST.Value
Worksheets("KWITANSI").Cells(2, 6) = TxtNOANG.Value
Worksheets("KWITANSI").Cells(23, 6) = TxtNOANG.Value
Worksheets("KWITANSI").Cells(12, 10) = txtTGLP.Value
Worksheets("KWITANSI").Cells(35, 10) = txtTGLP.Value
Worksheets("KWITANSI").Cells(18, 14) = txtNM.Value
Worksheets("KWITANSI").Cells(18, 14) = txtNM.Value
Worksheets("KWITANSI").Cells(6, 8) = "=TERBILANG(R[12]C[-3])"
Worksheets("KWITANSI").Cells(27, 8) = "=TERBILANG(R[12]C[-3])"
Worksheets("KWITANSI").Cells(18, 5) = TxtPINJ.Value
Worksheets("KWITANSI").Cells(39, 5) = TxtPINJ.Value
End With

Select Case cboRST.Value
Case "ANGGREK"
Dim CellANGGREK As Long
With Worksheets("ANGGREK")
CellANGGREK = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'--- data input
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 1).Value = CellANGGREK - 1
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 2).Value = txtTGLP.Value
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 3).Value = (Day(txtTGLP.Value))
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 4).Value = TxtNOANG.Value
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 5).Value = txtNM.Value
If optDINAS = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 6).Value = 1
ElseIf optPENSIUNAN = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 7).Value = 1
ElseIf optUMUM = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 8).Value = 1
ElseIf optATM = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 8).Value = 1
End If
If optLAMA = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 10).Value = 1
ElseIf optBARU = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 11).Value = 1
End If
If optLAMA = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 12).Value = TxtPINJ.Value
ElseIf optBARU = True Then
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 13).Value = TxtPINJ.Value
End If
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 14).Value = (TxtPINJ.Value * 3 / 100)
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 15).Value = "=IF(RC[-4]=1,5000,"""")"
Worksheets("ANGGREK").Cells(CellANGGREK + 1, 16).Value = "=SUM(RC[-4]:RC[-3])-SUM(RC[-2]:RC[-1])"
End With

Case "MAWAR"
Dim CellMAWAR As Long
With Worksheets("MAWAR")
CellMAWAR = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'--- data input
Worksheets("MAWAR").Cells(CellMAWAR + 1, 1).Value = CellMAWAR - 1
Worksheets("MAWAR").Cells(CellMAWAR + 1, 2).Value = txtTGLP.Value
Worksheets("MAWAR").Cells(CellMAWAR + 1, 3).Value = (Day(txtTGLP.Value))
Worksheets("MAWAR").Cells(CellMAWAR + 1, 4).Value = TxtNOANG.Value
Worksheets("MAWAR").Cells(CellMAWAR + 1, 5).Value = txtNM.Value
If optDINAS = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 6).Value = 1
ElseIf optPENSIUNAN = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 7).Value = 1
ElseIf optUMUM = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 8).Value = 1
ElseIf optATM = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 8).Value = 1
End If
If optLAMA = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 10).Value = 1
ElseIf optBARU = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 11).Value = 1
End If
If optLAMA = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 12).Value = TxtPINJ.Value
ElseIf optBARU = True Then
Worksheets("MAWAR").Cells(CellMAWAR + 1, 13).Value = TxtPINJ.Value
End If
Worksheets("MAWAR").Cells(CellMAWAR + 1, 14).Value = (TxtPINJ.Value * 3 / 100)
Worksheets("MAWAR").Cells(CellMAWAR + 1, 15).Value = "=IF(RC[-4]=1,5000,"""")"
Worksheets("MAWAR").Cells(CellMAWAR + 1, 16).Value = "=SUM(RC[-4]:RC[-3])-SUM(RC[-2]:RC[-1])"
End With

Case ("TERATAI")
Dim CellTERATAI As Long
With Worksheets("TERATAI")
CellTERATAI = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'--- data input
Worksheets("TERATAI").Cells(CellTERATAI + 1, 1).Value = CellTERATAI - 1
Worksheets("TERATAI").Cells(CellTERATAI + 1, 2).Value = txtTGLP.Value
Worksheets("TERATAI").Cells(CellTERATAI + 1, 3).Value = (Day(txtTGLP.Value))
Worksheets("TERATAI").Cells(CellTERATAI + 1, 4).Value = TxtNOANG.Value
Worksheets("TERATAI").Cells(CellTERATAI + 1, 5).Value = txtNM.Value
If optDINAS = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 6).Value = 1
ElseIf optPENSIUNAN = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 7).Value = 1
ElseIf optUMUM = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 8).Value = 1
ElseIf optATM = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 8).Value = 1
End If
If optLAMA = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 10).Value = 1
ElseIf optBARU = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 11).Value = 1
End If
If optLAMA = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 12).Value = TxtPINJ.Value
ElseIf optBARU = True Then
Worksheets("TERATAI").Cells(CellTERATAI + 1, 13).Value = TxtPINJ.Value
End If
Worksheets("TERATAI").Cells(CellTERATAI + 1, 14).Value = (TxtPINJ.Value * 3 / 100)
Worksheets("TERATAI").Cells(CellTERATAI + 1, 15).Value = "=IF(RC[-4]=1,5000,"""")"
Worksheets("TERATAI").Cells(CellTERATAI + 1, 16).Value = "=SUM(RC[-4]:RC[-3])-SUM(RC[-2]:RC[-1])"
End With
End Select

txtNIK.Value = ""
cboRST.Value = ""
TxtNOANG.Value = ""
TxtTGA.Value = ""
txtNM.Value = ""
txtTMP.Value = ""
txtTGL.Value = ""
txtJR.Value = ""
txtKC.Value = ""
TxtANG.Value = ""
TxtJAM.Value = ""
cboBANK.Value = ""
txtNOBANK.Value = ""
TxtBAYARDI.Value = ""
txtKJ.Value = ""
txtTGLP.Value = ""
TxtPINJ.Value = ""
optLAMA.Value = ""
optBARU.Value = ""
optDINAS.Value = ""
optPENSIUNAN.Value = ""
optUMUM.Value = ""
optATM.Value = ""
TxtKE.Value = ""
txtHP.Value = ""
Cbobayar.Value = ""
TxtGaji.Value = ""
JMGAJI.Value = ""
MsgBox "Data sudah disimpan", vbOKOnly
End Sub
UNTUK INSERT FOTO ANGGOTA
Private Sub cmdnamafoto_Click()
On Error Resume Next
Dim Filter As String, Title As String, FileX As String
Dim SourceFile, DestinationFile

x.SetFocus
Filter = "JPG Image Files Only(*.jpg),*.jpg,"
Title = "Silahkan Pilih Logo"
FileX = Application.GetOpenFilename(Filter, , Title)
NamaFile = (cboRST.Value + TxtNOANG.Value + " " + txtNM.Value)
FOTO.Picture = LoadPicture(FileX)
   FOTO.Height = TRANSAKSI.Height - 405 '+ Image1.Height
  FOTO.Width = TRANSAKSI.Width - 655 '+ Image1.Height
   FOTO.Top = 36
   FOTO.Left = 606
DestinationFile = ActiveWorkbook.Path & "\Photo\" & NamaFile & ".jpg"
FileCopy FileX, DestinationFile
End Sub
UNTUK CONTOHNYA BISA DI DOWNLOAD DI BAWAH INI
DOWNLOAD

Rabu, 08 Oktober 2014

MEMBUAT ENTRI CARI SIMPAN EDIT HAPUS DENGAN MACRO EXCEL

Private Sub cmdCari_Click()
Dim KodeSiswa
Dim CellTujuan As Range

KodeSiswa = txtKodeSiswa.Text
Set CellTujuan = Range("B:B").Find(What:=KodeSiswa)

If Not CellTujuan Is Nothing Then
txtNamaSiswa.Text = Cells(CellTujuan.Row, 3)
cmbProgramStudi.Text = Cells(CellTujuan.Row, 4)
If Cells(CellTujuan.Row, 5) = "Laki-laki" Then
optLakiLaki.Value = True
ElseIf Cells(CellTujuan.Row, 5) = "Perempuan" Then optPerempuan.Value = True
End If
txtTempatLahir.Text = Cells(CellTujuan.Row, 6)
Else
MsgBox "Tidak Ada Hasil !"
End If
End Sub

Private Sub cmdTambah_Click() 
    Dim baris As Integer
                baris = WorksheetFunction.CountA(Range("B:B"))

baris = baris + 1

               Cells(baris, 2) = txtKodeSiswa 
       Cells(baris, 3) = txtNamaSiswa 
       Cells(baris, 4) = cmbProgramStudi
       If optLakiLaki = True Then 
       Cells(baris, 5) = "Laki-laki" 
       ElseIf optPerempuan = True Then
Cells(baris, 5) = "Perempuan" End If
Cells(baris, 6) = txtTempatLahir

Cells(baris, 7) = txtTanggalLahir
  End Sub

Private Sub cmdUbah_Click() Dim KodeSiswa
Dim CellTujuan As Range

                KodeSiswa = txtKodeSiswa.Text

Set CellTujuan = Range("B:B").Find(What:=KodeSiswa)

  
Cells(CellTujuan.Row, 2) = txtKodeSiswa Cells(CellTujuan.Row, 3) = txtNamaSiswa Cells(CellTujuan.Row, 4) = cmbProgramStudi If optLakiLaki = True Then Cells(CellTujuan.Row, 5) = "Laki-laki" ElseIf optPerempuan = True Then Cells(CellTujuan.Row, 5) = "Perempuan"
End If
Cells(CellTujuan.Row, 6) = txtTempatLahir Cells(CellTujuan.Row, 7) =txtTanggalLahir End Sub

Private Sub cmdHapus_Click() Dim KodeSiswa
Dim CellTujuan As Range

KodeSiswa = txtKodeSiswa.Text
Set CellTujuan =Range("B:B").Find(What:=KodeSiswa) Rows(CellTujuan.Row).Delete Shift:=xlUp
End Sub



RUMUS MENCARI BARIS ATAU KOLOM YANG KOSONG DENGAN MACRO EXCEL

Private Sub BarisKosong_satu()
Dim BarisKosong
BarisKosong = Cells(1, 1).End(xlDown).Offset(1, 0).Row
MsgBox "cara satu :" & BarisKosong
End Sub

Private Sub BarisKosong_dua()
Dim BarisKosong
BarisKosong = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
MsgBox "cara dua :" & BarisKosong
End Sub

Private Sub BarisKosong_tiga()
Dim BarisKosong
Dim i
i = 1
Do While Cells(i, 1) <> ""
i = i + 1
Loop
BarisKosong = i
MsgBox "cara tiga :" & BarisKosong
End Sub


Private Sub BarisKosong_empat()
Dim BarisKosong
Dim i
i = 1
Do While Not IsEmpty(Cells(i, 1))
i = i + 1
Loop
BarisKosong = i
MsgBox "cara empat :" & BarisKosong
End Sub

Private Sub BarisKosong_lima() 'prosesnya lama
Dim BarisKosong
Dim i
i = Rows.Count
Do While IsEmpty(Cells(i, 1))
i = i - 1
Loop
BarisKosong = i + 1
MsgBox "cara lima :" & BarisKosong
End Sub

Private Sub BarisKosong_enam()
Dim BarisKosong
Dim i
i = 1
Do While Not IsEmpty(Cells(i, 1))
BarisKosong = Cells(i, 1).Offset(1, 0).Row
i = i + 1
Loop
'BarisKosong = i + 1
MsgBox "cara enam :" & BarisKosong
End Sub

Private Sub BarisKosong_tujuh() 'prosesnya lama
Dim BarisKosong
Dim i
i = Rows.Count
Do While IsEmpty(Cells(i, 1))
BarisKosong = Cells(i, 1).Offset(-1, 0).Row
i = i - 1
Loop
BarisKosong = BarisKosong + 1
MsgBox "cara tujuh :" & BarisKosong
End Sub

'============================
Private Sub kolomKosong_satu()
Dim kolomKosong
kolomKosong = Cells(1, 1).End(xlToRight).Offset(0, 1).Column
MsgBox "cara satu :" & kolomKosong
End Sub

Private Sub kolomKosong_dua()
Dim kolomKosong
kolomKosong = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
MsgBox "cara dua :" & kolomKosong
End Sub

'silakan berkreasi sendiri semoga sukses

'secara manual cari baris kosong adalah sebagai berikut :
'1. pilih cels A1
'2. tekan enter atau panah bawah terus sampai ketemu baris yang kosong
'kalau dibahasakan dengan VBA
'Cells(1,1) = meletakkan poniter ke cell A1
'.End = sampai mentok/akhir
'(xlDown)=panah atas
'offset = geser
'(1,0)=argument gesernya =1 baris ke bawah, 0 kolom ke kanan artinya tetap dikolom A
' .Row = mengambil nilai baris

'baris kosong = Cells(1, 1).End(xlDown).Offset(1, 0).Row
'artinya seolah kita pilih cell A1 kemudian tekan panah ke bawah sampai baris terakhir
'yang ada isinya, kemudian turun satu baris lagi,
'kemudian nilai barisnya disimpan dalam variabel yang bernama "BarisKosong"
' maka inilah baris kosong pertama

'Lain lagi jika 'baris kosong = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'ini artinya seolah kita pilih cells kolom A paling bawah terus tekan panah atas
'sampai mentok ketemu cell yang tidak kosong kemudian geser ke bawah 1 baris,
'kemudian nilai barisnya disimpan dalam variabel yang bernama "BarisKosong"

'rows.count = menunjukkan bnyak baris dalam worksheet, nilainya tergantung versi excel/ms office nya
'kalau versi 2003=
'kalau versi 2007 = 1048576
'dll

'columns.Count =menunjukkan jumlah kolom dalam worksheet, nilai juga tergantu versinya
'kalau versi 2007 = 16384
'
'dengan cara yang sama di atas kode berikut ini juga dipahami
'cuma berbeda arahnya
'kolomKosong = Cells(1, 1).End(xlToRight).Offset(0, 1).Column
'kolomKosong = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column

' xlUp = panah ke atas
' xlDown = panah ke bawah
' xlToRight = panah ke kanan
' xlToLeft = panah ke kiri
'
' Do while
'......
'......
' Loop

' adalah perintah untuk iterasi/perulangan
' artinya kode-kode di antara Do While ... Loop akan terus dijalankan jika syarat kondisinya terpenuhi
' syarat kondisi diletakkan setelah kata "while" tersebut
' Do While cells(i,1)<>"" artinya kerjakan selama cells(baris i kolom 1) tidak kosong
' sama maksudnya dengan perintah Do While Not IsEmpty