APLIKASI GUDANG VERSI EXCEL VBA

Aplikasi Gudang Sederhana silahkan dikembangkan

kritik dan saran membangun selalu kami harapkan

FROM ENTRI IURAN BULANAN DI   >>>

DISINI

DAPATKAN SEGERA

PAKET BELAJAR FULL VBA

Ada beberapa paket pilihan sebagai tambahan Refetensi

Khususnya VBA dilengkapi ratusan contoh file xlsm 

dgn kode kode sederhana buat praktek langsung dilembar excel 

dan terbukti lebih cepat menguasai vba

                                         Unduh file disini  APLIKASI GUDANG  

                                                          >>> aplikasi gudang

APLIKASI SIAP RW

Dapatkan Segera aplikasi Data Keuangan RW !!!

Kerja lebih mudah dan lebih berpropesional

Hemat waktu dan tenaga !!!

Harga bersahabat

TABEL REKAP  DATA OTOMATIS :

1. TABEL DATA SELURUH DUSUN

2. FILTER DATA SETIAP RT             

Khusus bagi Pejabat RW sebab berbayar

hubungi kami di watsapp >>  I PUTU ASANA

Form Entri Iuran Bulanan

Membuat form entri Iuran Bulanan

Private Sub ComboBox1_Change()

If ComboBox1.Value = ActiveSheet.Range("d7") Then TextBox20.Value = 1

If ComboBox1.Value = ActiveSheet.Range("e7") Then TextBox20.Value = 2

If ComboBox1.Value = ActiveSheet.Range("f7") Then TextBox20.Value = 3

If ComboBox1.Value = ActiveSheet.Range("g7") Then TextBox20.Value = 4

If ComboBox1.Value = ActiveSheet.Range("h7") Then TextBox20.Value = 5

If ComboBox1.Value = ActiveSheet.Range("i7") Then TextBox20.Value = 6

If ComboBox1.Value = ActiveSheet.Range("j7") Then TextBox20.Value = 7

If ComboBox1.Value = ActiveSheet.Range("k7") Then TextBox20.Value = 8

If ComboBox1.Value = ActiveSheet.Range("l7") Then TextBox20.Value = 9

If ComboBox1.Value = ActiveSheet.Range("m7") Then TextBox20.Value = 10

If ComboBox1.Value = ActiveSheet.Range("n7") Then TextBox20.Value = 11

If ComboBox1.Value = ActiveSheet.Range("o7") Then TextBox20.Value = 12

End Sub

Private Sub CommandButton2_Click()

Data = NOMOR.Value

With ActiveSheet.Range("A8:B100")

Set c = .Find(Data, LookIn:=xlValues)

If TextBox1.Value = "" Then

 MsgBox "Bulan Bayar belum diisi", vbCritical

ElseIf Not c Is Nothing Then

BARIS = c.row

a = TextBox20.Value

ActiveSheet.Cells(BARIS, 3).Offset(0, a).Value = TextBox1.Value

End If

End With

CommandButton7_Click

End Sub

Private Sub CommandButton7_Click()

Cari = NOMOR.Value

With ActiveSheet.Range("A8:A500")

Set c = .Find(Cari, LookIn:=xlValues)

If Not c Is Nothing Then

BARIS = c.row

Label16.Caption = ActiveSheet.Cells(BARIS, 4).Value

Label17.Caption = ActiveSheet.Cells(BARIS, 5).Value

Label18.Caption = ActiveSheet.Cells(BARIS, 6).Value

Label19.Caption = ActiveSheet.Cells(BARIS, 7).Value

Label20.Caption = ActiveSheet.Cells(BARIS, 8).Value

Label21.Caption = ActiveSheet.Cells(BARIS, 9).Value

Label22.Caption = ActiveSheet.Cells(BARIS, 10).Value

Label23.Caption = ActiveSheet.Cells(BARIS, 11).Value

Label24.Caption = ActiveSheet.Cells(BARIS, 12).Value

Label25.Caption = ActiveSheet.Cells(BARIS, 13).Value

Label26.Caption = ActiveSheet.Cells(BARIS, 14).Value

Label27.Caption = ActiveSheet.Cells(BARIS, 15).Value

 End If

End With

End Sub

Silahkan di coba 

semoga bermanfaat !!!!

Unduh sampel file xlsm >>>>>   FORM ENTRI IURAN

Dapatkan pula from entri data lainnya :

                     Entri  Data Kependudukan disini >>>>>

form kependudukan

                           APLIKASI KK SEMENTARA  :

  APLIKASI KK SEMENTAR

Aplikasi Siap RT >>> SIAP RT

APLIKASI KARTU KELUARGA SEMENTARA

KODE PADA USERFORM PENCARIAN

Private Sub CommandButton1_Click()

Worksheets("ANAK").Range("A45:W60").Value = ""

Call Modul_____Data___kk

End Sub

Private Sub ListBox1_Click()

TextBox14 = ListBox1.List(ListBox1.ListIndex, 1)

TextBox15.Text = ListBox1.List(ListBox1.ListIndex, 4)

TextBox16.Text = ListBox1.List(ListBox1.ListIndex, 3)

Sheets("DATA").Cells(1, 7).Value = TextBox14.Value

End Sub

Private Sub OptionButton2_Click()

Sheets("PENCARIAN").Range("B7").Value = 3

End Sub

Private Sub OptionButton3_Click()

Sheets("PENCARIAN").Range("B7").Value = 4

End Sub

Private Sub TextBox14_Change()

Sheets("DATA").Cells(1, 7).Value = TextBox14.Value

End Sub

Private Sub TextBox18_Change()

Sheets("PENCARIAN").Range("E8").Value = TextBox18.Value

End Sub

Private Sub UserForm_Initialize()

ListBox1.ColumnCount = 6

ListBox1.ColumnHeads = True

ListBox1.ColumnWidths = 0 & ";" & 0 & ";" & 120 & ";" & 100 & ";" & 0 & ";" & 0

ListBox1.RowSource = "CARI"

OptionButton2 = True

End Sub

KODE PADA MODUL

 Sub Modul_____Data___kk()

 Worksheets("DATA").Select

  Dim c As Range

  Dim j As Integer

  Dim Source As Worksheet

  Dim Target As Worksheet

  Set Source = ActiveWorkbook.Worksheets("DATA")

  Set Target = ActiveWorkbook.Worksheets("ANAK")

  j = 45  ' Start copying to row 1 in target sheet

  For Each c In Source.Range("C8:C6000") 

      If c = Worksheets("DATA").Range("G1") Then

          Source.Rows(c.row).Copy Target.Rows(j)

          j = j + 1

      End If

  Next c

  Application.CutCopyMode = False

  Worksheets("ANAK").Select

End Sub

UNDUH FILE >>> KK SEMENTARA

APLIKASI DATA DAN ADMINISTRASI RT

Dapatkan Segera aplikasi Data dan Keuangan RT !!!
Kerja lebih mudah dan lebih berpropesional
Hemat waktu dan tenaga !!!
Harga bersahabat

Khusus bagi Pejabat RT sebab berbayar

hubungi kami di watsapp >>  I PUTU ASANA

Aplikasi Entri data Penduduk

KODE  INPUT

 Private Sub CommandButton1_Click()

Dim iRow As Long

iRow = Sheets("DATA").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).row

Sheets("DATA").Cells(iRow, 3).Value = TextBox13.Value

Sheets("DATA").Cells(iRow, 4).Value = ("'" & TextBox1.Value)

Sheets("DATA").Cells(iRow, 5).Value = TextBox2.Value

Sheets("DATA").Cells(iRow, 6).Value = ("'" & TextBox3.Value)

Sheets("DATA").Cells(iRow, 7).Value = ComboBox1.Value

Sheets("DATA").Cells(iRow, 8).Value = ComboBox2.Value

Sheets("DATA").Cells(iRow, 9).Value = TextBox4.Value

Sheets("DATA").Cells(iRow, 10).Value = TextBox22.Value

Sheets("DATA").Cells(iRow, 11).Value = ComboBox3.Value

Sheets("DATA").Cells(iRow, 12).Value = ComboBox4.Value

Sheets("DATA").Cells(iRow, 13).Value = ComboBox5.Value

Sheets("DATA").Cells(iRow, 14).Value = ComboBox6.Value

Sheets("DATA").Cells(iRow, 15).Value = TextBox6.Value

Sheets("DATA").Cells(iRow, 16).Value = TextBox7.Value

Sheets("DATA").Cells(iRow, 17).Value = TextBox8.Value

Sheets("DATA").Cells(iRow, 18).Value = TextBox9.Value

Sheets("DATA").Cells(iRow, 19).Value = TextBox10.Value

Sheets("DATA").Cells(iRow, 20).Value = TextBox11.Value

Sheets("DATA").Cells(iRow, 21).Value = ComboBox7.Value

Sheets("DATA").Cells(iRow, 22).Value = TextBox12.Value

End Sub

KODE EDIT

Private Sub CommandButton8_Click()

Data = NOMOR.Value

With Sheets("Data").Range("B8:B6000")

Set c = .Find(Data, LookIn:=xlValues)

If TextBox1.Value = "" Then

 MsgBox "nama belum terdaftar", vbCritical

ElseIf Not c Is Nothing Then

BARIS = c.row

Sheets("Data").Cells(BARIS, 3).Value = TextBox13.Value

Sheets("Data").Cells(BARIS, 4).Value = TextBox1.Value

Sheets("Data").Cells(BARIS, 5).Value = TextBox2.Value

Sheets("Data").Cells(BARIS, 6).Value = TextBox3.Value

Sheets("Data").Cells(BARIS, 7).Value = ComboBox1.Value

Sheets("Data").Cells(BARIS, 8).Value = ComboBox2.Value

Sheets("Data").Cells(BARIS, 9).Value = TextBox4.Value

Sheets("Data").Cells(BARIS, 10).Value = TextBox5.Value

Sheets("Data").Cells(BARIS, 11).Value = ComboBox3.Value

Sheets("Data").Cells(BARIS, 12).Value = ComboBox4.Value

Sheets("Data").Cells(BARIS, 13).Value = ComboBox5.Value

Sheets("Data").Cells(BARIS, 14).Value = ComboBox6.Value

Sheets("Data").Cells(BARIS, 15).Value = TextBox6.Value

Sheets("Data").Cells(BARIS, 16).Value = TextBox7.Value

Sheets("Data").Cells(BARIS, 17).Value = TextBox8.Value

Sheets("Data").Cells(BARIS, 18).Value = TextBox9.Value

Sheets("Data").Cells(BARIS, 19).Value = TextBox10.Value

Sheets("Data").Cells(BARIS, 20).Value = TextBox11.Value

Sheets("Data").Cells(BARIS, 21).Value = ComboBox7.Value

Sheets("Data").Cells(BARIS, 22).Value = TextBox12.Value

End If

End With

KOSONG_Click

End Sub

KODE PENOMORAN

Private Sub CommandButton12_Click()

'PENOMORAN

Dim Sr As Long

Range("A9").Value = "= IF(COUNTIF(C8:C9,C9)=2,0,IF(COUNTIF(C8:C9,C9)=1,C9,0))"

Sr = Range("j" & Rows.Count).End(xlUp).row

Range("A9: " & "A" & Sr).FillDown

'-------------------------------------

'NOMOR__URUT

Range("a1") = Application.CountA(Range("E8:E3000")) + 1

No = 1

For xx = 1 To Range("a1")

No = No + 1

Cells(No + 7, 2).Value = No

Next xx

'-----------------------------------------

'Copy formula

Dim x As Worksheet, LastRow&

Set x = Worksheets("DATA")

LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).row

x.Range("A8:C" & LastRow).Copy

x.Range("A8:C" & LastRow).PasteSpecial Paste:=xlPasteValues

x.Range("W8:X" & LastRow).Copy

x.Range("W8:X" & LastRow).PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

TextBox28.Value = Sheets("DATA").Cells(6, 5).Value

TextBox29.Value = Sheets("DATA").Cells(6, 6).Value

TextBox30.Value = Sheets("DATA").Cells(6, 7).Value

End Sub

HITUNG UMUR

Private Sub CommandButton16_Click()

' UMUR

Range("x1").Value = "y"

Range("W1").Value = Now()

Dim SB As Long

Range("X8").Value = "=IF(E8<>0,DATEDIF(J8,$w$1,$x$1),0)"

SB = Range("J" & Rows.Count).End(xlUp).row

Range("W8: " & "x" & SB).FillDown

'----------------------------------------

End Sub

 KODE BORDER

Private Sub CommandButton3_Click()

'Border

Dim LastRow As Long, LastCol As Long

  Cells.Borders.LineStyle = xlNone

  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).row

  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column

  With Range("A7", Cells(LastRow, LastCol))

    .BorderAround xlDouble

    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash

    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous

    .Font.FontStyle = "Italic"

    .Font.Size = 11

  End With

'Pewarnaan Kepala Keluarga

Worksheets("data").Range("a8:X3000").Interior.ColorIndex = 2

   Dim i As Long, r1 As Range, r2 As Range

   For i = 8 To Range("A1") + 7

      Set r1 = Range("G" & i)

      Set r2 = Range("A" & i & ":X" & i)

      If r1.Value = "Kepala Keluarga" Then r2.Interior.ColorIndex = 35

      If r1.Value = "Istri" Then r2.Interior.ColorIndex = 34

   Next i

End Sub

UNDUH SAMPE FILE XLSM  >> FORM ENTRI DATA PENDUDUK