Cetak struk pakai printer star tipe cutter 1

Kemarin aku nyoba membuat program dengan memanfaatkan printer star aku lupa serinya tapi tipe kayak di market2 yang bisa langsung ada cutternya dan lebarnya cuma sekitar 6-8 cm. menggunakan kertas penggulung. Dulu pernah aku prosting gimana cara agar kertas berhenti sendiri dan tidak menggulung terus. tapi cara tersebut tidak bisa untuk mengatur besar kecilnya huruf. setelah browsing kesana-kemari dan mampir ke situs www.vb-bego.net di salam forumnya di bahas tapi akhirnya juga harus pakai ocx dan di komersilkan ya terpaksa sih cari-cari referensi yang lainnya. setelah cukup lama akhirnya aku menemukan gimana cara agar bisa membuat tulisannya tebal. dan aku gabungkan dengan source untuk tidak menggulung terus. silahkan di lanjutkan aja.

langsung aja aku berikan sourcenya aja ya

Open "Lpt1" For Output As #1

Print #1, Chr(27) & "@" 'mendekeksi printer
Print #1, Chr(27) & "A" & Chr(11)
Print #1, Chr(27) & "E" 'Membuat Tebal
Print #1, "Mencetak dengan ukuran 2 kali biasa"
Print #1, "Mencetak dengan ukuran 2 kali biasa"
Print #1, Chr(27) & "F" ' membuat normal kembali

Print #1, "Mencetak yang normal-normal saja"
Print #1, "Mencetak yang normal-normal saja"

Close #1

printer langsung mencetak sesuai dengan perintah dan akan berhenti sendiri deh.
source code ini aku dapat dari www.pscode.com. Terima kasih bagi yang buat.

semoga aja bermanfaat.

chung chin

Read more

Satu lagi cara membuat report dengan Ms Excell

Kemarin pada waktu aku berkunjung ke www.vb-bego.net aku menemukan source code gimana cara membuat report atau laporan dengan MS. Excell. langsung aja ya aku kasih sourcenya..
terima kasih kepada RidenX yang merupakan member dari www.vb-bego.net
untuk lihat sourcenya lanjutkan aja ya
saya tunggu komentarnya

Dim ApExcel As Object ' persiapkan untuk object Excel
Private Sub Command1_Click()
Dim i As Integer
Dim nama(5) As String
Dim alm(5) As String
Dim gaji(5) As String
'-------ambil data-------------------
Open App.Path & "\data.txt" For Input As #1
i = 1
Do
Input #1, nama(i), alm(i), gaji(i)
If nama(i) = "" Then Exit Do
i = i + 1
Loop Until EOF(1)


Set ApExcel = CreateObject("Excel.application") 'bikin object
ApExcel.Visible = True ' excel muncul
ApExcel.workbooks.Add 'nambahin workbook.
ApExcel.sheets("sheet1").Name = "SATU" ' me Rename Sheet satu
ApExcel.sheets("sheet2").Name = "DUA" ' me Rename Sheet dua
ApExcel.sheets("sheet3").Name = "TIGA" ' me Rename Sheet tiga
ApExcel.sheets("SATU").Activate 'Aktifkan Sheet satu



With ApExcel

.CELLS(1, 1).Value = "PT. INDONESIA TENTREM ADEM"
.CELLS(2, 1).Value = "REKAP GAJI BULAN " & UCase(Format(Month(Now), "MMMM")) & " TAHUN " & Year(Now)


.CELLS(1, 1).Font.COLORINDEX = 17 ' beri warna
.CELLS(2, 1).Font.COLORINDEX = 17



.CELLS(3, 1).Value = "No." 'Menulis di kolom 1 baris 1
.CELLS(3, 2).Value = "NAMA" 'Menulis di Kolom 2 baris 1
.CELLS(3, 3).Value = "ALAMAT" ' Menulis di kolom 3 baris 1
.CELLS(3, 4).Value = "GAJI"


.Columns(1).columnwidth = 6 ' set kolom 1 lebarnya 6
.Columns(2).columnwidth = 20 'set kolom 2 lebarnya 20
.Columns(3).columnwidth = 20 'set kolom 3 lebarnya 20
.Columns(4).columnwidth = 20 'set kolom 4 lebarnya 20
.sheets("SATU").RANGE("A1:d3").Font.Bold = True ' Bikin cetak tebel dari kolom A sampe C di sheet satu
.CELLS(3, 1).horizontalalignment = 3 '
.CELLS(3, 2).horizontalalignment = 3 'Bikin ketengah semua
.CELLS(3, 3).horizontalalignment = 3 '
.CELLS(3, 4).horizontalalignment = 3 '
For i = 1 To 5
.CELLS(3 + i, 1).Value = i 'tulis no urut
.CELLS(3 + i, 2).Value = nama(i) ' tulis nama
.CELLS(3 + i, 3).Value = alm(i) ' tulis alamat
.CELLS(3 + i, 4).Value = Format(gaji(i), "#,###,###") ' tulis gaji
Next i

.CELLS(4 + i, 4).formula = Format("=sum(D3:D" & 3 + i & ")", "#,###,###") ' sum data gajinya
.CELLS(4 + i, 2).Value = "TOTAL"
.CELLS(4 + i, 2).horizontalalignment = 3
.sheets("SATU").RANGE("b" & 4 + i & ":d" & 4 + i).Font.Bold = True 'cetak tebal bawahnya
.RANGE("a3:d" & 4 + i).borders.linestyle = 1 ' buat kotak
End With

Close (1) ' tutup file text

End Sub

databasenya menggunakan file txt jadi anda anda harus mempunyai file txt
silahkan anda buka notepad kemudian copas ni data

Unyil,Tangerang, 5000000
usro,Jakarta,1000000
Jontor,Bekasi,500000
Bapuk,Bogor,789000
JAenab,Jakarta,2000000

kemudian simpan dengan nama "data.txt"
semoga aja bermanfaat

chung chin

Read more

Terusan Export Excell dari database dengan VB6

Setelah beberapa waktu yang lalu aku posting tentang export excell dari database kita dengan VB6 n adanya kesalahan dalam penulisan kode, setelah aku analisis dan pemberitahuan teman maka aku tambahi ni source codenya.
pada waktu kemarin itu kurang tranposedim(array)

Function TransposeDim(v As Variant) As Variant
Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant

Xupper = UBound(v, 2)
Yupper = UBound(v, 1)

ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next Y
Next X

TransposeDim = tempArray

End Function

terima kasih atas kunjungan, tolong kasih komentarnya donk.
semoga bermanfaat aja

Read more

Grid dengan tampilan XP - Vista dgn VB

Kalau yang berkecimpung di dunia pemrogram Visual basic bosan dengan data grid yang tampilannya standar bisa beralih menggunakan LynxGrid dengan tampilan dari XP - Vista. grid ini merupakan gabungan antara listview dengan grid sehingga bisa menampilkan data kita. pada versi terakhir telah ada untuk mencetak data kita ke clipboard maupun ke file. Pokoknya sip deh....

Ini tampilan form yang telah aku buat dengan gird tersebut:



gambar yang pertama merupakan gridnya dan gambar kedua merupakan hasil preview data yang telah kita masukkan ke grid sehingga bisa di cetak dengan printer. kemudian bisa juga di export ke excell tapi dengan sedikit modifikasi.

berikut aku berikan author(pembuat) lynxGrid

'// Title: LynxGrid version 2
'// Author: Morgan Haueisen
'// Modified: 7/12/07
'// Version: 2.15.4a (11 May 2009)(see HistoryLog file for details)
'// MOST CHANGES MADE BY MORGAN HAUEISEN ARE MARKED AS '// MLH
'// Downloaded from: klik disini

'*************************************************************************************************
' Title: Original LynxGrid
' Author: Richard Mewett
' Created: 01/08/05
' Version: 1.89 (10 May 2007)
' Copyright © 2005 Richard Mewett. All rights reserved.
' Provides a combination of MSFlexGrid and ListView (Report Style) functionality.
' Downloaded from: Klik disini

Read more

Export database kita ke Excell

Aku posting judul ini karena ada seseorang yang bertanya gimana cara mengeksport database kita ke MS. Exc*ll dengan sekali klik sehingga bisa di edit lagi dan di cetak menurut selera kita. Sebenarnya udah banyak yang memberikan tutorial sekaligus source codenya. saya di sini hanya mengingatkan sekaligus berbagai buat teman-teman saya. hehe....
Maaf kalau ada yang sama, aku cuma ambil source code ini dari www.pscode.com.
Langsung aja ya silahkan di lanjutkan....

Pertama-tama anda buat database anda entah pakai MS Access atau MySQL. tapi dalam contoh ini saya pakai Access.
kemudian anda hubungkan akses anda dengan visual basic. kalau udah berhasil sekarang silahkan tambah satu command lagi untuk eksport data anda. silahkan di pelajari code dibawah ini:

Private Sub cmdExcell_Click()
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim recArray As Variant
Dim strDB As String
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer

Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets(1)

xlApp.Visible = True
xlApp.UserControl = True

fldCount = rsDaftar.RecordCount
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rsDaftar.Fields(iCol - 1).Name
Next

If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
xlWs.Cells(2, 1).CopyFromRecordset rsDaftar

Else
recArray = rsDaftar.GetRows
recCount = UBound(recArray, 2) + 1
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow
Next iCol '
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If

xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
rsDaftar.Close
Set rsDaftar = Nothing
Set xlWs = Nothing
Set xlWb = Nothing

Set xlApp = Nothing
End Sub

dalam code diatas pemanggil databasenya ada rsdaftar yang merupakan recordset nya.

sekian dulu semoga bermanfaat, kalau masih belum jelas silahkan kasih komentarnya. kalau ada tambahan juga boleh kasih komentarnya.

thank

chung chin

Read more

Burning File lebih dari 700 MB pakai K3B

Tutorial ini aku buat karena keinginkanku untuk mencoba linux di laptop aku, akhirnya setelah browsing kesana kemari aku menemukan DewaLinux yang filenya lebih dari 700 MB setelah putar-putar cari CD dengan kapasitas lebih dari 700MB di kotaku ga ketemu, mau aku bakar di DVD terlalu kecil (bahasa jawanya Nyakang) sehingga aku cari artikel mengenai burning di Cd lebih dari 700 Mb dari beberapa artikel kuncinya cuma overburn yaitu membakar lebih dari 700MB. di Nero juga ada tapi aku coba ga bisa akhirnya ada tutoriaal membakar dengan k3b yang dimiliki linux, aku buka linux ubuntu ku yang ada di kantor ehhh ternyata udah terinstall k3b jadi ga perlu download lagi, bagi yang belum untuk ubuntu ketik sudo apt-get install k3b. tunggu sampai proses selesai.

setelah software terinstall tinggal setting tu k3b dengan overburning kemudian anda tinggal burning di file.
semoga bermanfaat aja.

Read more

Gagal Install Blankon di Laptop BYON M31W

Kemarin pada waktu cari tutorial gimana cara install Linux dengan driver VGA SIS di dalamnya. akhirnya pengen coba distro Blankon buatan dalan negeri sendiri. setelah donlot beberapa lama n beberapa kali gagal. akhirnya aku suruh teman saya untuk mendownloadkan dan berrhasil donwnload Blankon yang versi 4 setelah burning Cd aku coba n juga aku masukan kata kunci acpi=off noapic nolapic setelah proses boooting tetep aja layar gerak terus sehingga tidak dapat diteruskan installasinya. Karena ingin coba maka aku download lagi yang versi 5 aku burning n coba install tetep aja ga bisa.
bagi temen-teman yang bisa bantu tolong donk kash masukkannya.....

Read more

Menjalankan BackTrack (BT) 3 di Laptop BYON M31W

Sudah sekian lama aku beli laptop BYON yang sangat menjengkelkan kalau di install linux dan sudah beberapa kali aku coba menginstall linux di laptopku, tapi hasilnya nihil hehe...hee... maklum newbie kalau linux, setelah tanya sana sini dan browsing akhirnya dapat juga menginstall linux di dalam laptopku kuncinya yaitu acpi=off noapic nolapic. udah aku coba bebrapa linux akhirnya bisa di install termasuk ubuntu.
permasalahan muncul lagi pada waktu nyoba menjalankan BT3 karena keinginkan untuk belajar hacking WEP jadi mencoba menjalankan.. tapi udah aku masuknya kata kuncinya acpi=off noapic nolapic dan jreeeeeng akhirnya ga bisa masuk ke GUI hanya sampai command aja.

karena penasaran aku coba oprek tu cara agar bisa masuk ke BT3 tapi mentok juga, akhirnya aku coba semua menu pilihan pada waktu booting BT3 dan akhirnya pada menu yang VESA grapic akhirnya aku bisa masuk juga. permasalahannya emang pada driver sis yang yang bisa untuk layar BYON, hehe...
tapi jangan lupa juga memasukkan kata kuncinya...
semoga bermanfaatttt....

Read more

Cetak kertas continous biar tidak menggulung di LX 300

Ini merupakan source code yang ada di forum.vbbego.net semoga aja source code ini bermanfaat dan udah aku manfaatkan untuk program parkir sebuah rumah sakit di daerah jawa tengah. silahkan anda lanjutkan aja ya....

hehe....
anda udah melanjutkan ya
ni aku kasih source codenya

anda buat dulu classmodule dan di beri nama clsRAWPrinter
silahkan anda copas ni source code

Option Explicit


Public Enum PrinterErrors
vbPE_CantOpenPrinter = 2000 ' Can't Open the printer device.
vbPE_CantStartJob ' Can't Start the print job.
vbPE_CantStartPage ' Can't start printing a page.
vbPE_UnSentBytes ' Some bytes were not successfully sent to the printer.
vbPE_KillDocFailed ' Could not cancel the print job.
vbPE_CantChangeName ' Can't change document name.
vbPE_FailedWrite ' Failed write to printer.
vbPE_ReadFileError ' Could not read from file.
vbPE_CantEndPage ' Call to end page failed.
vbPE_CantEndDoc ' Call to close doc failed.
vbPE_CantChangeDevice ' Can't change device while printing.
vbPE_CantCreateDC ' Can't create a device context.
End Enum

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
pDefault As Any) As Long

Private Declare Function StartDocPrinter Lib "winspool.drv" Alias _
"StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pDocInfo As Any) As Long

Private Declare Function StartPagePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Function EndDocPrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Function EndPagePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Type DOC_INFO_1
pDocName As String
pOutputFile As String
pDatatype As String
End Type

Private Declare Function SetJob Lib "winspool.drv" Alias _
"SetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, _
ByVal Level As Long, pJob As Any, _
ByVal Command As Long) As Long

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type JOB_INFO_1
JobId As Long
pPrinterName As String
pMachineName As String
pUserName As String
pDocument As String
pDatatype As String
pStatus As String
Status As Long
Priority As Long
Position As Long
TotalPages As Long
PagesPrinted As Long
Submitted As SYSTEMTIME
End Type

Private Const JOB_POSITION_UNSPECIFIED = 0

Private Declare Function GetJob Lib "winspool.drv" Alias "GetJobA" _
(ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, _
pJob As Any, ByVal cdBuf As Long, pcbNeeded As Long) As Long

Private Const MAX_PRIORITY = 99
Private Const MIN_PRIORITY = 1
Private Const DEF_PRIORITY = 1


Private Declare Function WritePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long, pBuf As Any, _
ByVal cdBuf As Long, pcWritten As Long) As Long


Private Const JOB_CONTROL_PAUSE = 1
Private Const JOB_CONTROL_RESUME = 2
Private Const JOB_CONTROL_CANCEL = 3
Private Const JOB_CONTROL_RESTART = 4
Private Const JOB_CONTROL_DELETE = 5


Private lPrinter As Long ' Printer handle
Private lBytesWritten As Long ' Number of bytes written
Private lBytesSent As Long ' Number of bytes that should have been written.
Private lJob As Long ' Print job handle
Private sDocName As String ' Name of the document
Private sDeviceName As String ' Device name.

Private bJobStarted As Boolean ' Have we started a print job.

Public Sub NewPage()
If Not bJobStarted Then
NewDoc
Else
'end last page
If EndPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantEndPage, "RAWPrinter", "Can't end page."
Exit Sub
End If

If StartPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantStartPage, "RAWPrinter", "Can't start page."
Exit Sub
End If
End If
End Sub

Public Sub NewDoc(Optional DocName As String = "", Optional FileName As String = vbNullString)
Dim di As DOC_INFO_1

If bJobStarted Then
EndDoc
End If

If OpenPrinter(sDeviceName, lPrinter, ByVal 0&) <= 0 Then
Err.Raise vbPE_CantOpenPrinter, "RAWPrinter", "Can't Open Printer Device"
Exit Sub
End If

If DocName <> "" Then
sDocName = DocName
End If

di.pDocName = sDocName & vbNullChar
If FileName = vbNullString Then
di.pOutputFile = FileName
Else
di.pOutputFile = FileName & vbNullChar
End If
di.pDatatype = "RAW" & vbNullChar

lJob = StartDocPrinter(lPrinter, 1, di)

If lJob <= 0 Then
Call ClosePrinter(lPrinter)
Err.Raise vbPE_CantStartJob, "RAWPrinter", "Can't start print job."
Exit Sub
End If

If StartPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
Err.Raise vbPE_CantStartPage, "RAWPrinter", "Can't start page."
Exit Sub
End If

lBytesWritten = 0
lBytesSent = 0
bJobStarted = True
End Sub

Public Sub KillDoc()
Dim b As Long

If bJobStarted Then
b = SetJob(lPrinter, lJob, 0, ByVal 0&, JOB_CONTROL_CANCEL)
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Else
b = 0
End If

If b <= 0 Then
Err.Raise vbPE_KillDocFailed, "RAWPrinter", "Could not cancle the print job."
End If
End Sub

Public Sub EndDoc()
If Not bJobStarted Then
Exit Sub
End If

If EndPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantEndPage, "RAWPrinter", "Can't end page."
Exit Sub
End If

If EndDocPrinter(lPrinter) <= 0 Then
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantEndDoc, "RAWPrinter", "Can't end print job."
Exit Sub
End If

Call ClosePrinter(lPrinter)

bJobStarted = False

If lBytesWritten <> lBytesSent Then
Err.Raise vbPE_UnSentBytes, "RAWPrinter", "Some data was not sent to the printer."
End If
End Sub

Public Property Let DeviceName(Name As String)
If bJobStarted Then
Err.Raise vbPE_CantChangeDevice, "RAWPrinter", "Can't change device while printing."
Else
sDeviceName = Name
End If
End Property

Public Property Get DeviceName() As String
DeviceName = sDeviceName
End Property

'
' Bug... this doesn't work
'
Public Property Let DocumentName(DocName As String)
Dim di As JOB_INFO_1

If bJobStarted Then
di.pDocument = DocName & vbNullChar

If SetJob(lPrinter, lJob, 1, di, 0&) <= 0 Then
Err.Raise vbPE_CantChangeName, "RAWPrinter", "Failed to change document name."
Exit Property
End If
End If

sDocName = DocName
End Property

Public Property Get DocumentName() As String
DocumentName = sDocName
End Property

Public Sub PrintText(txt As String)
Dim i As Long

If Not bJobStarted Then
NewDoc
End If

lBytesSent = lBytesSent + Len(txt)

If WritePrinter(lPrinter, ByVal txt, Len(txt), i) = 0 Then
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_FailedWrite, "RAWPrinter", "Failed write to printer."
Exit Sub
End If

lBytesWritten = lBytesWritten + i
End Sub

Public Sub PrintFile(fname As String)
Dim fh As Long
Dim Buffer As String
Dim fl As Long
Dim r As Long
Dim i As Long
Dim bs As Long

If Not bJobStarted Then
NewDoc
End If

fh = FreeFile(0)
bs = 8192
Buffer = String(bs, 0)

Open fname For Binary Access Read As fh
fl = LOF(fh)
r = 0

If fl = 0 Then
Close fh
Exit Sub
End If

Do
If fl - r < bs Then
bs = fl - r
Buffer = String(bs, 0)
End If

Get fh, , Buffer

lBytesSent = lBytesSent + bs
r = r + bs

If WritePrinter(lPrinter, ByVal Buffer, bs, i) = 0 Then
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
On Error GoTo 0
Err.Raise vbPE_FailedWrite, "RAWPrinter", "Failed write to printer."
Exit Sub
End If

lBytesWritten = lBytesWritten + i
Loop While r <> fl

Close fh
Exit Sub

PrintFileError:
On Error Resume Next

Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Close fh

On Error GoTo 0
Err.Raise vbPE_ReadFileError, "RAWPrinter", "Could not read from file."
End Sub

Private Sub Class_Initialize()
sDocName = "Visual Basic - RAWPrinter"
sDeviceName = Printer.DeviceName
bJobStarted = False
End Sub

Private Sub Class_Terminate()
If bJobStarted Then
EndDoc
End If
End Sub

Public Property Get hPrinter() As Long
hPrinter = lPrinter
End Property

Public Property Get hJob() As Long
hJob = lJob
End Property

Public Property Get Priority() As Long
Dim di As String ' stores JOB_INFO_1
Dim i As Long

Call GetJob(lPrinter, lJob, 1, ByVal di, 0, i)
di = String(i, 0)
Call CopyMemory(i, ByVal (Mid$(di, 33, 4)), 4)

Priority = i
End Property

' Bug: Doesn't work?
Public Property Let Priority(ByVal i As Long)
Dim di As JOB_INFO_1

'JobId, pPrinterName, pMachineName, pDrivername,
'Size, Submitted, and Time are ignored
If i < MIN_PRIORITY Then
i = DEF_PRIORITY
ElseIf i > MAX_PRIORITY Then
i = MAX_PRIORITY
End If

di.Priority = i
di.Position = JOB_POSITION_UNSPECIFIED
di.pUserName = vbNullString
di.pDocument = vbNullString
di.pDatatype = vbNullString
di.pStatus = vbNullString
di.Status = 0
di.TotalPages = 0
di.PagesPrinted = 0

Call SetJob(lPrinter, lJob, 1, di, 0)
End Property

anda sudah copas, silahkan anda buat source code sesuai keingginan sebagai contoh ni aku kasih source code yang aku buat pada project parkir aku

Sub Printing()
Dim p As New clsRAWPrinter
Open App.Path + "\cetak.txt" For Output As #1
Print #1, Tab(1); Nama
Print #1, Tab(1); Alamat
Print #1, Tab(1); "Telp. " + Telp
Print #1, Tab(1); " "
Print #1, Tab(1); "===================================="
Print #1, Tab(1); "Parkir tanggal " + txtFields(0).Text
Print #1, Tab(1); "No. Karcis = " + NoKarcis
Print #1, Tab(1); "Nopol = " + txtFields(1).Text + txtFields(2).Text + txtFields(3).Text
Print #1, Tab(1); "Tarif = " + Bayare
Print #1, Tab(1); "Petugas = " + txtPetugas.Text
Print #1, Tab(1); "====> Terima Kasih <==="
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Close #1
p.PrintFile (App.Path + "\cetak.txt")
p.EndDoc
End Sub

selamat mencoba ya semoga sukses

Read more