Re: ]] XL-mania [[ Format Tanggal di TextBox

 

Mungkin formatnya dibuat lebih umum untuk semua regional setting, yaitu YYYY-MM-DD
kemudian tinggal cek

Dim dateTgl as date

On Error Resume Next
datetgl=cdate(trim$(txtTgl.text))
if err.number <>0 then
       err.clear
       msgbox "Error input, isi dengan format YYYY-MM-DD"
else
      'misal simpan ke cell s7
      sheets("sheet_ku").range("s7").value = datetgl
      msgbox "Done."
endif


Kira-kira begitu, mungkin ada yang kurang, setidaknya bisa lebih simple bila disempurnakan

Kid.

2011/5/12 STDEV(i) <setiyowati.devi@gmail.com>

sebetulnya untuk mengentry data tanggal,  ndak usah pakai textbox, ndak usah diatur atur 

kita dapat menggunakan control DateTimePicker (DTPicker), tetapi kalau anda termasuk 

anti Dtpicker ya pakailah control yg paling anda senangi (mungkin textbox) dengan 

pemrogramannyua kira kira spt ini

Format yg dikehendaki "DD/MM/YYYY"    length = 10

karakter ke3 dan ke6 harus "/", karakter lain harus salah satu dari "0123456789"

jika ketikan sampai pada krakter ke 3 atau ke 6 maka kibor harus hanya mau trima  "/" saja.

ketika ketikan sampai pada karakter lainnya kibor harus hanya mau menerima "0123456789"

saja...

Cara inipun masih pakai "cara bodoh-bodohan: karena  : oleh user yg kurang kerjaan

2 karakter ke 1 dan 2 (DD)  bisa saja diisi 99 (lebih besar dari nilai 31), dan 

2 karakter ke 4 dan 5 (MM) bisa diisi dua karakter yg lebih besar daripada nilai 12

Tetapi di akhir pengetikan (ketika ketikan sudah sampai karakter ke 10, kepada user "nyelèlèk"

seperti itu kita harus berikan pelajaran yang setimpal !?!. 

lho iyaa, kita harus balas dendam to ?  sekarang ini kan sudah jamannya ..

pada saat ketukan ke 10 terdeteksi; kita masukkan 3 komponen tanggal tsb (DD MM dan YYYY)

ke dalam fungsi DateSerial (setara dengan fungsi DATE di woksit)

Nah disitulah tanggal  56 bulan 17 tahun berapa saja < 9999, hasil ketikan user "nyelèlèk", 

kita ubah menjadi nilai validnya. 

Sekarang siapa yg terdengar ketawanya ?!?

Kita yg gantian tertawa gumbira , dan user cemberut kuciwa...

'-------

Private Sub TextBox1_Change()

   ' siti Vi // memaksa texbox berisi format date DD/MM/YYYY

   ' misal jika nilai DD dan atau nilai MM tidak valid misal

   ' diisi 33/13/2010 maka akan di ubah menjadi tgl tgl 02/02/2011

   ' kalau dgn cara ini nanti usernya marah, mending kita ajak

   ' tawuran aja dech, he he ...

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

   Dim s As String, x As String

   s = TextBox1.Text

   x = Right(s, 1)

   

   Application.EnableEvents = False

   Select Case Len(s)

      Case 1, 2, 4, 5, 7 To 10

         If InStr(1, "0123456789", x, vbTextCompare) = 0 Then

            s = Left(s, Len(s) - 1)

            TextBox1 = s

         End If

       Case 3, 6

         If Not x = "/" Then

            s = Left(s, Len(s) - 1)

            TextBox1 = s

         End If

   End Select

   If Len(s) = 10 Then

      TextBox1 = Format(DateSerial(CInt(Right(s, 4)), _

      CInt(Mid(s, 4, 2)), CInt(Left(s, 2))), "dd/mm/yyyy")

   End If

   

   Application.EnableEvents = True

End Sub

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

tombol OK even click:    Range("A1") = TextBox1

On Thu, May 12, 2011 at 9:43 AM, Surya Hartantu <suryahartantu@yahoo.com> wrote:

Dear XL-Mania,

Mohon bantuannya......
Saya mempunyai userform dimana ada textboxnya
Saya ingin nantinya user hanya bisa input date format "DD/MM/YYYY"

dan hasil inputan akan masuk ke sheet2.cell A1.

Minta tolong ya scriptnya...

Makasih

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (4)

Recent Activity:

• New Members 91

Visit Your Group

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| maaf baru moderate sekarang... momods kurang tidur berhari-hari   |
| jadi budak kantoooOOooorrr...                                     |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message,  melecehkan,  tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan  winzip  jika  perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke  |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau...  |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id]  |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___