vb程序打印表格線?Public Sub PrintsalaryList1() ' Dim printer As Printer '初始化Printer對象，今天小編就來聊一聊關于vb程序打印表格線?接下來我們就一起去研究一下吧!

vb程序打印表格線

Public Sub PrintsalaryList1() ' Dim printer As Printer '初始化Printer對象

Dim PageHeader As Long '打印頁上部留空 Dim PageFooter As Long '打印頁下部留空 Dim PageLeft As Long '打印頁左部留空 Dim PageRight As Long '打印頁右部留空 Dim UseWidth As Long Dim UseHeight As Long Dim i, j, k, c, b As Integer Dim Word As String Dim StartX As Long Dim StartY As Long Dim StartyLine As Long '用來紀錄打印豎線的起點 Dim EndyLine As Long ' 用來紀錄打印豎線的末點 Dim strTitle As String Const w1 = 1.5, w2 = 2 '設置線與字段之間的距離 Const h = 14 '設置表格的高度 Dim v(40) As Variant '定義數組 将字段值導入 Dim N As Integer '用于記錄表的列數 Dim l1, l2, m, t As Variant '設置标題 strTitle = t1 N = Adodc1.Recordset.Fields.Count ' Dim strSubTitle As String ' strSubTitle = "Printer對象打印報表實例" '建立一個ADO數據連接 ' Dim DataConn As New ADODB.Connection ' Dim DataRec As New ADODB.Recordset ' Dim strSQL As String '若數據庫連接出錯，則轉向ConnectionERR ' On Error GoTo ConnectionERR ' '建立一個連接字串 ' '這個連接串可能根據數據庫配置的不同而不同 ' DataConn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" ' DataConn.ConnectionString = DataConn.ConnectionString & "Persist Security Info=False;" ' DataConn.ConnectionString = DataConn.ConnectionString & "Initial Catalog=pubs;" ' DataConn.ConnectionString = DataConn.ConnectionString & "Data Source=land-net" ' '建立數據庫連接 ' DataConn.Open ' '若RecordSet建立出錯，則轉向RecordsetERR ' On Error GoTo RecordSetERR ' strSQL = "SELECT au_lname,au_fname,phone " ' '從表authors查詢 ' strSQL = strSQL & "FROM authors" ' DataRec.Open strSQL, DataConn ' On ERRor GoTo PrintERR '設置頁面參數 On Error GoTo PrintERR PageHeader = 5 PageFooter = 25 PageLeft = 20 PageRight = 20 With Printer .ScaleMode = 6 .ScaleLeft = 0 .ScaleTop = -5 '設置紙型 .PaperSize = psize .FontSize = fsize ' .ScaleWidth = 210 ' .ScaleHeight = 297 UseWidth = .ScaleWidth UseHeight = .ScaleHeight - 30 .CurrentX = 0 .CurrentY = 0 .DrawWidth = 1 .DrawStyle = 6 End With '打印數據和網格線 Dim yy As Variant yy = 0 c = 0 Do Until Adodc1.Recordset.EOF '将字段值導入到數組中去 For b = 0 To N - 1 v(b) = "" & Adodc1.Recordset.Fields(b).Value Next b ' '判斷是否該頁已打滿，若已滿,開始新的一頁 If Printer.CurrentY >= UseHeight Then '開始新的一頁 Printer.NewPage End If ' 設置打印頭的初始位置 With Printer .CurrentX = PageLeft .ScaleLeft .CurrentY = PageHeader yy ' StartyLine = .CurrentY End With '' 打印标題 With Printer .CurrentX = (UseWidth - .TextWidth(strTitle)) / 2 ' .CurrentY = PageHeader .ScaleTop End With Printer.Print strTitle ' 保存坐标y Dim x1, y1, x2, y2 As Variant y1 = PageHeader yy 1 ' '打印表格的第一條線 '注意：Line方法不能用在With ....End With塊裡 ' 确定字段的總寬度 m = 0 For i = 0 To N - 1 l1 = Printer.TextWidth(Trim(pp(i))) ' If v(i) = Null Then ' l2 = 0 ' Else l2 = Printer.TextWidth(Trim(v(i))) ' End If If l1 >= l2 Then m = m l1 2 * w1 Else: m = m l2 2 * w1 End If Next i ' 設置打印頭坐标 With Printer .CurrentX = (UseWidth m) / 2 .CurrentY = y1 5 End With Printer.Line -((UseWidth - m) / 2, Printer.CurrentY) y2 = Printer.CurrentY x2 = Printer.CurrentX ' '打印表頭 ' 打印第一條豎線 Printer.Line -(x2, y2 h / 2) '' 打印其他的字段和豎線 Dim p1, p2 As Variant p1 = x2 w1 p2 = y2 w2 l1 = 0 l2 = 0 For j = 0 To N - 1 Printer.CurrentX = p1 Printer.CurrentY = p2 l1 = Printer.TextWidth(Trim(pp(j))) l2 = Printer.TextWidth(Trim(v(j))) If l1 >= l2 Then p1 = p1 l1 2 * w1 Else p1 = p1 l2 2 * w1 End If Printer.Print pp(j) Printer.Line (p1 - w1, y2 h / 2)-(p1 - w1, y2) Next j ' 打印中間的橫線 Printer.Line (p1 - w1, y2 h / 2)-(x2, y2 h / 2) '' 打印字段數據 ' 打印第一條豎線 Printer.Line (x2, y2 h / 2)-(x2, y2 h) ' 打印其他的字段數值和豎線 p1 = x2 w1 p2 = y2 w2 h / 2 l1 = 0 l2 = 0 For k = 0 To N - 1 Printer.CurrentX = p1 Printer.CurrentY = p2 l1 = Printer.TextWidth(Trim(pp(k))) l2 = Printer.TextWidth(Trim(v(k))) If l1 >= l2 Then p1 = p1 l1 2 * w1 Else p1 = p1 l2 2 * w1 End If Printer.Print v(k) Printer.Line (p1 - w1, y2 h)-(p1 - w1, y2 h / 2) Next k ' 打印最後一條橫線 Printer.Line (p1 - w1, y2 h)-(x2, y2 h) Adodc1.Recordset.MoveNext c = c 1 yy = (Printer.ScaleHeight / 6) * (c Mod 6) Loop '結束打印 Printer.EndDoc Exit Sub 'ConnectionERR: ' '錯誤處理程序 ' MsgBox "數據庫連接錯誤，" & Err.Description, vbCritical, "出錯" ' Exit Sub 'RecordSetERR: ' MsgBox "RecordSet生成錯誤，" & Err.Description, vbCritical, "錯誤" ' Exit Sub PrintERR: MsgBox "打印錯誤，" & Err.Description, vbCritical, "出錯" End Sub