Tips and Triks Visual Basic 6.0

Blog ini sudah DoFollow
Kumpulan Source Code tuk Validasi Program dengan menggunakan Visual Basic 6.o, Jika anda tertatik dengan Tips dan Trik Visual Basic ini Silahkan Baca di...

--> Hanya Angka yang bisa di Input dalam TextBoxt

Private Sub txtNomor_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") & Chr(13) _
And KeyAscii <= Asc("9") & Chr(13) _
Or KeyAscii = vbKeyBack _
Or KeyAscii = vbKeyDelete _
Or KeyAscii = vbKeySpace) Then
Beep
KeyAscii = 0
End If
End Sub

--> Hanya Huruf

Private Sub txtNama_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("a") & Chr(13) _
And KeyAscii <= Asc("z") & Chr(13) _
Or (KeyAscii >= Asc("A") & Chr(13) _
And KeyAscii <= Asc("Z") & Chr(13) _
Or KeyAscii = vbKeyBack _
Or KeyAscii = vbKeyDelete _
Or KeyAscii = vbKeySpace)) Then
Beep
KeyAscii = 0
End If

End Sub

--> membersihkan Seluruh Control TextBox dan Combo Box

Sub Clear()
For Each Control In Me.Controls
If TypeOf Control Is TextBox Then
Control.Text = ""
End If
If TypeOf Control Is ComboBox Then
Control.Text = ""
End If
Next Control
End Sub

NB: jika ada tombol yang lain tinggal di tambah kondisi IFnya aja, dan tuk menonaktifkan seluruh tombol tinggal ganti "Control.Text=Enabled" aja

--> Get Auto Number

Private Sub Auto()
Dim Urutan As String * 10
Dim Tgl As String
Dim Hitung
Set TMasuk = New ADODB.Recordset
TMasuk.Open "Select * from Masuk", Persediaan, adOpenDynamic, adLockPessimistic
'TMasuk.MoveFirst
Tgl = Format(Now, "yy/mm/dd")
With TMasuk
If .RecordCount = 0 Then
Urutan = Right(Tgl, 2) + Mid(Tgl, 4, 2) + Left(Tgl, 2) + "0001"
Else
.MoveLast
If Left(![No Masuk], 6) <> Right(Tgl, 2) + Mid(Tgl, 4, 2) + Left(Tgl, 2) Then
Urutan = Right(Tgl, 2) + Mid(Tgl, 4, 2) + Left(Tgl, 2) + "0001"
Else
Hitung = (![No Masuk]) + 1
Urutan = (Right(Tgl, 2) + Mid(Tgl, 4, 2) + Left(Tgl, 2)) + Right("0000" & Hitung, 4)
End If
End If
txtNomor = Urutan
End With
End Sub

--> Mengambil record ke dalam COmboBox

Sub DaftarPelanggan()
Me.MousePointer = 11
Pesan = "Select * from Pelanggan Order By kodePlg"
Set TPelanggan = New ADODB.Recordset
TPelanggan.Open Pesan, Persediaan, adOpenStatic
cmbPlg.Clear
If Not TPelanggan.EOF Then
TPelanggan.MoveFirst
While Not TPelanggan.EOF
cmbPlg.AddItem TPelanggan!KodePlg
TPelanggan.MoveNext
Wend
End If
TPelanggan.Close
Set TPelanggan = Nothing
Me.MousePointer = 1
End Sub

-- Laporan dengan Crystall Report

Sub CetakLap()
With CrtLaporan
.Reset
.DataFiles(0) = App.Path & "\Penduduk.mdb"
.ReportFileName = App.Path & "\Lap Lahir.rpt"
.WindowMinButton = False
.WindowShowCancelBtn = True
.WindowShowCloseBtn = True
.WindowShowPrintBtn = True
.WindowShowPrintSetupBtn = True
.WindowState = crptMaximized
.Action = 1
End With
end sub

--> terima kasih...
sumber amirmahmud2008.blogspot.com