[belajar-excel] std aplikasi

classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

[belajar-excel] std aplikasi

boyok
met pagi siang dan malam

para pakar excel

mohon bantuanya untuk pembuatan std aplikasi

trims

y2k

Std Aplikasi.xlsx (13K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: [belajar-excel] std aplikasi

iHaps
Kasus ini sepertinya pernah terbaca entah dimana (mungkin di toko sebelah)
sejak beberapa hari/minggu y.l.
Kalau belum ada tanggapan, kayaknya karena ke-taklengkap-an info yg
diberikan oleh penanya.

*** di badan email:*
*"mohon bantuanya untuk pembuatan std aplikasi"*
*** di sheet:*
*"Bagaimana caranya dalam 1 bulan, jika 1 lokasi aplikasi 2x atau lebih
bisa muncul seperti diatas dengan basic dari sheet std"*

Berhubung cara menyampaikan masalah HANYA tanya, tapi OGAH menjelaskan
masalah, maka jawabannya ini pasti tidak sesuai dengan keinginan, mohon
dimaklumi..
Khusus untuk Haps, berhubung pasti tidak sempat, maka untuk casae ini tidak
akan ada kelanjutan, panambahan info, maupuan tanyajawab ini itu lagi..

[image: Inline image 1]

'======= Module UserForm ===========
Option Explicit
' VBA Coded by indri hapsari / 1 Mar 2012
' BeExcel Case :
' http://tech.groups.yahoo.com/group/belajar-excel/message/16044
' ------------------------------------------------
Dim TabelStd As Range, TblHasil As Range
Dim TglTanam As Date, Lengkap As Boolean
'-------------------------------------
Private Sub UserForm_Initialize()
   Dim i As Integer
   Set TabelStd = Sheets("Std").Range("C2").CurrentRegion.Offset(3, 0)
   Set TabelStd = TabelStd.Resize(TabelStd.Rows.Count - 3,
TabelStd.Columns.Count)
   Set TblHasil = Sheets("Renc").Range("B3").CurrentRegion.Offset(2, 0)
   TblHasil.ClearContents

   CboHari.Clear: CboHari.ListRows = 16
   For i = 1 To 31: CboHari.AddItem i: Next i
   CboBulan.Clear: CboBulan.ListRows = 12
   For i = 1 To 12: CboBulan.AddItem i: Next i
   TxtTahun = Year(Date)
   CboJangka.Clear: CboJangka.ListRows = 4
   For i = 1 To 24: CboJangka.AddItem i: Next i
End Sub

Private Sub Set_TglTanam()
   If CboHari.ListIndex >= 0 Then
      If CboBulan.ListIndex >= 0 Then
         If CLng(TxtTahun) > 0 Then
            TglTanam = DateSerial( _
               CLng(TxtTahun), CInt(CboBulan), CInt(CboHari))
            LbTglTanam = Format(TglTanam, "dd MMM yyyy")
         End If
      End If
   End If
End Sub

Private Sub CboHari_Change()
   Set_TglTanam
End Sub

Private Sub Cbobulan_Change()
   Set_TglTanam
End Sub

Private Sub TxtTahun_AfterUpdate()
   Set_TglTanam
End Sub

Private Sub Cmd_Cancel_Click()
   CboHari.ListIndex = -1
   CboBulan.ListIndex = -1
   CboJangka.ListIndex = -1
   TxtLokasi = ""
   TxtLuas = ""
   TxtTahun = ""
End Sub

Private Sub Cmd_Close_Click()
   Unload Me
End Sub

Private Sub Cmd_OK_Click()
' VBA Coded by indri hapsari / 1 Mar 2012
' BeExcel Case :
' http://tech.groups.yahoo.com/group/belajar-excel/message/16044
' ------------------------------------------------
   Dim i As Integer, r As Integer, n As Integer
   Dim TglAkhir As Date, TglAplik As Date
   ValidasiDataIsian
   If Not Lengkap Then Exit Sub
   TglAkhir = DateAdd("m", CboJangka, TglTanam) - 1
   TglAplik = TglTanam
   For n = 1 To TabelStd.Rows.Count
      TglAplik = TglAplik + 10
      If TglAplik <= TglAkhir Then
         r = r + 1
         TblHasil(r, 1).Value = TxtLokasi
         TblHasil(r, 2).Value = CInt(TxtLuas)
         TblHasil(r, 3).Value = TglTanam
         TblHasil(r, 4).Resize(1, 6).Value = _
            TabelStd(n, 1).Resize(1, 6).Value
         TblHasil(r, 5).Value = TglAplik
      End If
   Next n
End Sub

Private Sub ValidasiDataIsian()
   Lengkap = False
   If TxtLokasi = "" Then
      MsgBox "Data 'Lokasi' belum ditentukan !"
      TxtLokasi.SetFocus: Exit Sub
   End If
   If TxtLuas = "" Then
      MsgBox "Data 'LUAS' belum ditentukan !"
      TxtLuas.SetFocus: Exit Sub
   End If
   If LbTglTanam = "D  M  YYYY" Then
      MsgBox "Data 'Tgl Tanam' belum ditentukan !"
      CboHari.SetFocus: Exit Sub
   End If
   If CboJangka.ListIndex = -1 Then
      MsgBox "Data 'Jangka Waktu' belum ditentukan !"
      CboJangka.SetFocus
      Exit Sub
   End If
   Lengkap = True
End Sub

'=====Module Sheet 'Renc' =====
Private Sub Generate_Cmd_Click()
   Frm_Kriteria.Show
End Sub
Private Sub Hapus_Cmd_Click()
   Range("B3").CurrentRegion.Offset(2, 0).ClearContents
End Sub
'-------


*- i Haps -*
*maarweg - 5000 koln; 6 feb 2012*



2012/3/1 boyok boyok <[hidden email]>

> **
>
> met pagi siang dan malam
> para pakar excel
> mohon bantuanya untuk pembuatan std aplikasi
> trims
> y2k
>

KriteriaForm.PNG (16K) Download Attachment
Std Aplikasi (VBAcode - iHaps).xlsm (67K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: [belajar-excel] std aplikasi

huda yusmaul
In reply to this post by boyok
std aplikasi apa pak?



________________________________
 From: boyok boyok <[hidden email]>
To: "[hidden email]" <[hidden email]>
Sent: Thursday, March 1, 2012 9:28 PM
Subject: [belajar-excel] std aplikasi
 

 
met pagi siang dan malam

para pakar excel

mohon bantuanya untuk pembuatan std aplikasi

trims

y2k