Pembulatan Angka vb6

Private Function Genapkan(ByVal Number As Double, Optional Range = 100) As Double
  Genapkan = (Round((Number / Range) + 0.49)) * Range
End Function


Private Sub Hitung()
On Error Resume Next
Dim v_sisa_harga As Double
Dim v_harga_angs As Double
Dim v_bunga As Double
Dim persen_bunga As Integer
persen_bunga = CInt(tbunga.Text)

v_sisa_harga = CDbl(tharga_jual.Text) - CDbl(tuangmuka.Text)
v_harga_angs = v_sisa_harga / CInt(tlamaangsuran.Text)
v_bunga = (persen_bunga / 100 * v_sisa_harga) ' / CInt(tlamaangsuran.Text)
tharga_angsuran = Genapkan(v_harga_angs + v_bunga)
ttotal_angsuran = CDbl(tharga_angsuran.Text) * CInt(tlamaangsuran.Text)
End Sub

Copy Image dari form ke sebuah folder

KODE UNTUK BROWSE IMAGE KE FORM

Private Sub CmdBrowse_Click()
CD.ShowOpen
imgfoto.Picture = LoadPicture(CD.FileName)
vFoto = CD.FileName
txtfotobahan.Text = vFoto
End Sub


KODE UNTUK MENG COPY  IMAGE KE SEBUAH FOLDER


Private Sub simpan_foto()
If txtfotobahan.Text <> "" Then
adobahanbaku.Recordset!fotobahan = "D:\restoran\fotobahanbaku\" & txtkodebahan.Text & ".jpg"
SavePicture imgfoto.Picture, "D:\restoran\fotobahanbaku\" & txtkodebahan & ".jpg"
End If
End Sub

Hapus beberapa Record Data / semua record tabel dengan ADODC

Private Sub hapus_pesan()
Adopesan.RecordSource = "select * from pesan where kodepesan='" & txtkodepesan.Text & "'"
Adopesan.Refresh
Dim hapus As Integer
For hapus = 1 To Adopesan.Recordset.RecordCount
Adopesan.Recordset.Delete
Adopesan.Recordset.Update
Adopesan.Recordset.MoveNext
Next hapus
End Sub

Cara Menambah dan Mengurangi Tanggal Pada Visual Basic

Untuk menambah dan mengurangi data bertipe Date/Tanggal tidak semudah dengan data bertipe Angka yang hanya menggunakan operator + dan -. Karena itu ada fungsi khusus untuk melakukannya, berikut contoh penggunaannya :

Fungsi : DateAdd( Jenis interval, Besar perubahan, Tanggal yang dihitung )

Jenis Interval	Keterangan
d	Day (Hari)
m	Month (Bulan)
yyyy	Year (Tahun)

h	Hour (Jam)
n	Minute (Menit)
s	Second (Detik)
ww	Week (Minggu)
q	Quater (4 Bulan)

Misalnya Anda ingin menghitung 2 hari setelah tanggal 15 Jan 2012 (ditulis #1/15/2012#), yang berarti akan menggunakan jenis interval "d" dan besar perubahannya adalah 2 
t = DateAdd("d", 2, #1/15/2012#) , hasilnya 17 Jan 2012

Sekarang jika Anda ingin menghitung 3 bulan sebelumnya, yang berarti akan menggunakan jenis interval "m" dan besar perubahaanya adalah -3. 
t = DateAdd("m", -3, #1/15/2012#) , hasilnya 15 Okt 2011

Jika Tanggal didapat dari kontrol semisal DateTimePicker, maka kodenya : 
DateTimePicker2.Value = DateAdd("m", -3, DateTimePicker1.Value)

dikutip dari:http://visualbasicfree.blogspot.com/2012/11/cara-menambah-dan-mengurangi-tanggal.html

Mengirim Value / isi Textbox ke Crystal report dengan Visual Basic 6

Terkadang saat ingin membuat sebuah report / laporan atau kwitansi , kita dihadapkan dengan harus mengirim sebuah isi dari sebuah text box tetapi textbox tersebut tidak tersimpan di database..

ada cara yang bisa dilakukan untuk mengirim data tersebut ke crystal report langkahnya sebagai berikut.

buka vb6 nya dan buat tampilannya seperti dibawah ini

kemudian buka crystal reportnya. pada field explorer

Klik kanan pada Parameter Fields, pilih New


pada name isikan nama parameternya contoh formula1

Klik OK, dan tambahkan parameter yang baru di buat ke lembar kerja crystal report


Kembali ke Visual Basic 6 , dobel klik pada command1 / cetak

ketikkan rumus dibawah ini

With CrystalReport1
.SelectionFormula = ""
.ParameterFields(0) = "formula1;" & Text1.Text & ";True"
.RetrieveDataFiles
.WindowState = crptMaximized
.Action = 1
End With

Keterangan:
.ParameterFields(0) = "formula1;" & Text1.Text & ";True"

formula1  => samakan dengan parameter yang dibuat di crystalreport
text1.text => isi dari text1 yang akan di tampilkan di crystal report

jika yang ditampilkan lebih dari 1, maka anda tinggal membuat parameter lagi di crytalreport dengan nama yang berbeda, contohnya

.ParameterFields(0) = "formula1;" & Text1.Text & ";True"
.ParameterFields(1) = "formula2;" & Text2.Text & ";True"
.ParameterFields(2) = "formula3;" & Text3.Text & ";True"

dst

sumber:http://chandraak.blogspot.com/2013/01/mengirim-value-isi-textbox-ke-crystal.html#comment-form

Membuat Fungsi Terbilang

BUAT MODUL:


Option Explicit
Public myCn As ADODB.Connection
Public Const vbKeyDecPt = 46
Public Function ConvertirEnText(ValNum As Double) As String

Static Unites(0 To 9) As String
Static Dixaines(0 To 9) As String
Static LesDixaines(0 To 9) As String
Static Milliers(0 To 4) As String

Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim strResultat As String
Dim strTemp As String
Dim tmpBuff As String

Unites(0) = "nol"
Unites(1) = "satu"
Unites(2) = "dua"
Unites(3) = "tiga"
Unites(4) = "empat"
Unites(5) = "lima"
Unites(6) = "enam"
Unites(7) = "tujuh"
Unites(8) = "delapan"
Unites(9) = "sembilan"

Dixaines(0) = "sepuluh"
Dixaines(1) = "sebelas"
Dixaines(2) = "dua belas"
Dixaines(3) = "tiga belas"
Dixaines(4) = "empat belas"
Dixaines(5) = "lima belas"
Dixaines(6) = "enam belas"
Dixaines(7) = "tujuh belas"
Dixaines(8) = "delapan belas"
Dixaines(9) = "sembilan belas"

LesDixaines(0) = ""
LesDixaines(1) = "sepuluh"
LesDixaines(2) = "dua puluh"
LesDixaines(3) = "tiga puluh"
LesDixaines(4) = "empat puluh"
LesDixaines(5) = "lima puluh"
LesDixaines(6) = "enam puluh"
LesDixaines(7) = "tujuh puluh"
LesDixaines(8) = "delapan puluh"
LesDixaines(9) = "sembilan puluh"

Milliers(0) = ""
Milliers(1) = "ribu"
Milliers(2) = "juta"
Milliers(3) = "milyard"
Milliers(4) = "triliyun"

On Error GoTo NbVersTexteError

strTemp = CStr(Int(ValNum)) 'Untuk Konversi Angka yang di format ke default

For i = Len(strTemp) To 1 Step -1
ValNb = Val(Mid$(strTemp, i, 1))
nPosition = (Len(strTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 1 Then
tmpBuff = Unites(ValNb) & " "
Else
tmpBuff = ""
End If
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = Dixaines(ValNb) & " "
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Unites(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = ""
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
End If
strResultat = tmpBuff & strResultat
Case 2
If ValNb > 0 Then
strResultat = LesDixaines(ValNb) & " " & _
strResultat
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
strResultat = Unites(ValNb) & " ratus " & _
strResultat
Else
strResultat = "seratus " & strResultat
End If
End If
End Select
Next i
If Len(strResultat) > 0 Then
strResultat = UCase$(Left$(strResultat, 1)) & _
Mid$(strResultat, 2)
End If

EndNbVersTexte:
ConvertirEnText = strResultat & " rupiah"
Exit Function

NbVersTexteError:
strResultat = "Une Erreur !"
Resume EndNbVersTexte
End Function

Public Function AngkaTerbilang(Counter As Double) As String
On Error Resume Next
Dim A As Single
AngkaTerbilang = ConvertirEnText(Counter)
A = Len(ConvertirEnText(Counter))
If Mid(ConvertirEnText(Counter), 1, 4) = "Ribu" Then
AngkaTerbilang = "Se" + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 4) = "Juta" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 7) = "" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 7) = "Milyard" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
End Function


BUAT FUNGSI TERBILANG DI HALAMAN CODE VB


Private Sub cari_terbilang()
If txttotalbayar <> "" Then
txttotalbayar.Text = Format(txttotalbayar, "#,##0")
txttotalbayar.SelStart = Len(txttotalbayar)
txtterbilang.Text = AngkaTerbilang(txttotalbayar.Text)
txtterbilang = StrConv(txtterbilang, vbProperCase)
Else
txtterbilang.Text = ""
End If
End Sub


EVENT GOT FOCUS PADA TXTTOTAL BAYAR

Private Sub txttotalbayar_GotFocus()
Call cari_terbilang
End Sub

Mengirim Value / isi Textbox ke Crystal report dengan Visual Basic 6

Terkadang saat ingin membuat sebuah report / laporan atau kwitansi , kita dihadapkan dengan harus mengirim sebuah isi dari sebuah text box tetapi textbox tersebut tidak tersimpan di database..

ada cara yang bisa dilakukan untuk mengirim data tersebut ke crystal report langkahnya sebagai berikut.

buka vb6 nya dan buat tampilannya seperti dibawah ini

kemudian buka crystal reportnya. pada field explorer

Klik kanan pada Parameter Fields, pilih New


pada name isikan nama parameternya contoh formula1

Klik OK, dan tambahkan parameter yang baru di buat ke lembar kerja crystal report


Kembali ke Visual Basic 6 , dobel klik pada command1 / cetak

ketikkan rumus dibawah ini

With CrystalReport1
.SelectionFormula = ""
.ParameterFields(0) = "formula1;" & Text1.Text & ";True"
.RetrieveDataFiles
.WindowState = crptMaximized
.Action = 1
End With

Keterangan:
.ParameterFields(0) = "formula1;" & Text1.Text & ";True"

formula1  => samakan dengan parameter yang dibuat di crystalreport
text1.text => isi dari text1 yang akan di tampilkan di crystal report

jika yang ditampilkan lebih dari 1, maka anda tinggal membuat parameter lagi di crytalreport dengan nama yang berbeda, contohnya

.ParameterFields(0) = "formula1;" & Text1.Text & ";True"
.ParameterFields(1) = "formula2;" & Text2.Text & ";True"
.ParameterFields(2) = "formula3;" & Text3.Text & ";True" 

dst


sumber dari:http://chandraak.blogspot.com/2013/01/mengirim-value-isi-textbox-ke-crystal.html#comment-form

Membuat Laporan Per Nota dengan Data Environtment VB6 (Tanpa Parameter)

KETIKKAN PADA TOMBOL CETAK
Private Sub CMDCETAKK_Click()
If tnota.Text = "" Then
    Exit Sub
Else
    DataEnvironment1.rscmd_angsuran.Open
    DataEnvironment1.rscmd_angsuran.Filter = "nota = '" & tnota.Text & "'"
    DR1.Show 1
    DataEnvironment1.rscmd_angsuran.Close
End If
End Sub

UNTUK REFRESH RECORD PADA SAAT PREVIEW DATA BERIKUTNYA, FILTER HARUS DIHILANGKAN DULU:


Private Sub cmdKeluar_Click()
DataEnvironment1.rscmd_angsuran.Open
DataEnvironment1.rscmd_angsuran.Requery
DR1.Refresh
DataEnvironment1.rscmd_angsuran.Filter = ""
DataEnvironment1.rscmd_angsuran.Close
Unload Me
End Sub

Laporan Per ID dengan Data Environtment

Buat koneksi  Data Environtment,

Buat command, contoh (CMDFILTER).  Laporan di sort berdasarkan ID, jadi di SQL statement buatlah parameter untuk mengisi nilai ID, contoh (bajindul)

Atau

Source code nya: