Rabu, 06 November 2013

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

Diposting oleh di Tidak ada komentar:

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
Diposting oleh di Tidak ada komentar:

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
Diposting oleh di Tidak ada komentar:

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
Diposting oleh di 1 komentar:

Senin, 04 November 2013


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

Diposting oleh di Tidak ada komentar:

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


Diposting oleh di Tidak ada komentar:

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
Diposting oleh di Tidak ada komentar:
Langganan: Postingan (Atom)