解决VisualBasic的Grid控件的打印问题

---- Grid 控 件 是Visual Basic 最 常 见 控 件 之 一， 从VB3.0 到VB5.0 都有 该 控 件。 也 是VB 爱 好 者 最 喜 爱 的 工 具 之 一。 用 它 可 以 以表 格 的 形 式 显 示、 浏 览 数 据， 特 别 是 数 据 库 应 用， 直 接 绑定 即 可 显 示 浏 览 数 据 库 信 息。 然 而， 美 中 不 足 的 是Grid 没有 编 辑 和 打 印 功 能， 列 与 列 的 位 置 不 能 相 互 交 换。 笔 者 曾尝 试 着 给Grid 增 添 了 这 些 功 能， 使 之 锦 上 添 花， 功 能 更 强大。 下 面 给 出 改 进 方 法 及 源 程 序， 读 者 只 需 按 步 骤 写 下 源程 序 即 可 使 你 的Grid 具 有 打 印 功 能。 该 程 序 笔 者 在HP5/100Window 95 环 境 下 用VB5.0 调 试 通 过。

---- 给Grid 控 件 增 加 打 印 方 法 有 三 种：1 是 直 接 打 印 控 件 的方 法，2 是 过 printer 来 实 现 打 印 功 能，3 是 通 过 调 用MS-WORD 及MS-EXCEl 来 实 现 打 印。

---- 首 先， 打 开 一 个 应 用， 在FORM1 中 增 加DATA 控 件DATA1, 把DATA1 的CONNECT 属 性 设 为dBASE III， 再 把DATABASENAME 属 性 设 为D:\PJXM.DBF。 然 后 再 在FORM1 中 增 加MSFLEXGRID 空 间GRID1， 并 把GRID1的DATASOURCE 属 性 设 为DATA1。 这 样 数 据 库PJXM.DBF 的 信 息 就 会 在GRID1 中 显 示 出 来。

---- 方 法 一： 直 接 打 印 窗 体 法， 在FORM1 中 增 加 命 令 按 钮(command)，CAPTION 属 性 设 为 直 接 打 印， 再 写 入 下 列 编 码：

Sub command_click
Form1.printform
End sub

---- 这 样 即 可 通 过 打 印 窗 体FORM1 的 方 法 把GRID1 的 数 据 打 印出 来， 遗 憾 的 是 只 能 打 印GRID1 中 显 示 的 数 据 部 分， 显 示 不出 来 的 则 无 法 打 印， 而 且 这 种 打 印 方 法 很 象 屏 幕 硬 拷 贝把 其 他 控 件 也 打 印 出 来。 也 不 能 灵 活 的 控 制 字 体 等。

---- 方 法 二： 通 过PRINTER 实 现 打 印。 这 种 方 法

---- 1、 加 入 打 印 命 令 按 钮(command1)、 函 数(prnt1) 即 可 实 现 打印 功 能， 写 入 下 面 代 码， 读 者 稍 加 改 动 可 写 成 标 准 的 函 数或 过 程。

Function prnt1 (x As Integer, y As Integer,
font As Single, txt As String)
printer.CurrentX = x
printer.CurrentY = y
printer.FontBold = False
printer.FontSize = font
printer.Print txt
End Function

Sub command1_click
Dim fnt As Single
Dim pp as integer
Pp=0''设置开始页码0
Dim stry,strx,strx1,stry1,linw,page1,p As Integer
Static a(8) As Integer''定义打印的列数
ss$ = "内部结算存入款对帐单"''定义表头
kan = 0
For i = 0 To 8
a(i) = 1500''定义每列宽
kan = kan + a(i)''计算表格总宽度
Next

page1 = 50''定义每页行数
strx = 200
strx1 = 200''定义X方向起始位置
stry = 1400
stry1 = 1400''定义Y方向起始位置
linw = 240''定义行宽
fnt = 8''定义字体大小
printer.fontname = "宋体"''定义字体

dd = prnt1(4000, 700, 18, ss$)''打印标题
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
For j = 0 To gridrow - 1''gridrow为所要打印的行数
grid1.row = j
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
p = p + 1
For i = 0 To 8
grid1.col = i
dd = prnt1(strx, stry, fnt, grid1.text)
strx = strx + a(i)
Next

If p > page1 Then''next page
p = 0
strx = strx1
''line last line
printer.Line (strx - 50, stry + linw)
-(strx + kan - 10, stry + linw)
stry = stry1
''line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+cstr(pp)+"页"
dd = prnt1(strx - 30-1000, stry + (page1 + 2)
* linw+100, 10, foot$)''打印页角码

printer.NewPage''next page
dd = prnt1(4000, 700, 18, ss$) ''打印标题
strx = strx1
stry = stry1
printer.Line (strx - 50, stry - 30)-
(strx + kan - 10, stry - 30)'' print first row
Else
stry = stry + linw
End If
Next
st = stry
If p < page1 Then ''在最后页剩余划空行
For o = p To page1 + 1
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
stry = stry + linw
Next
End If
stry = stry1
strx = strx1
stry = stry1 ''line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+cstr(pp)+"页"
dd = prnt1(strx - 30-1000, stry + (page1 + 2)
* linw+100, 10, foot$)''打印页角码

printer.EndDoc''打印结束
Endsub

---- 这 种 方 法 通 过 灵 活 的 编 程 可 以 方 便 地 调 整 字 体、 字 型、线 形、 页 面、 纸 张 大 小 等。 可 打 印 出 比 较 满 意 的 效 果。 如果 你 的 计 算 机 上 装 有MICROSOFT WORD 和MICRO EXCEL， 最 精 彩 的 用法 还 是 把GRID 的 表 格 通 过VB 发 送 到MICROSOFT WORD 及MICRO EXCEL。生 成MICROSOFT WORD 和MICRO EXCEL 表 格。 这 样 就 可 以 充 分 利 用MICROSOFT WORD 和MICRO EXCEL 的 打 印、 编 辑 功 能 打 印 出 更 理 想 的效 果。 下 面 逐 一 介 绍。

---- 方 法 三： 通 过 生 成MICROSOFT WORD 表 格 打 印

---- 1、 在declaration 中 写 入:

Dim msword As Object

---- 2、 加 入 打 印 命 令 按 钮(command2)，CAPTION 设 为" 生 成WORD 表
格"， 写 入 下 面 代 码，

Private Sub command2_Click()

screen.MousePointer = 11
Set msword = CreateObject("word.basic")

Dim AppID, ReturnValue
appID = Shell("d:\office97\office\WINWORD.EXE", 1)
'' Run Microsoft Word.

msword.AppActivate "Microsoft Word"
''msword.AppActivate "Microsoft Word", 1
full
Screen.MousePointer = 0
End Sub

---- 2、 写 入 以 下 过 程full()

Sub full()
Dim i As Integer, j As Integer,
col As Integer, row As Integer
Dim cellcontent As String
Me.Hide
cols = 4''表格的列数
row = gridrow''打印表的行数
msword.filenewdefault
msword.MsgBox "正在建立MS_WORD报表，
请稍候.......", "", -1
msword.leftpara
msword.screenupdating 0
msword.tableinserttable , col, row, , , 16, 167
msword.startofdocument
for j=0 to gridrow'' 表格的行数
grid1.row=j
For i = 1 To cols
Gri1d.col=i
If IsNull(grid1.text) Then
cellcontent$ = ""
Else
cellcontent$ = grid1.text
End If
msword.Insert cellcontent$
msword.nextcell
Next i
Next j
msword.tabledeleterow
msword.startofdocument
msword.tableselectrow
msword.tableheadings 1
msword.centerpara
''msword.startdocument
msword.screenrefresh
msword.screenupdating 1
msword.MsgBox " 结束", "", -1
Me.Show

End Sub

---- 方 法 四： 通 过 发 送 到MICROSOFT EXCEL 实 现 表 格 打 印

---- 1、 加 入 打 印 命 令 按 钮(command3)，CAPTION 设 为" 生 成EXCEL 表
格"， 写 入 下 面 代 码

Private Sub command3_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
''Set xlBook = xlApp.Workbooks.Add
''On Error Resume Next
Set xlBook = xlApp.Workbooks.Add ''Open("d:\text2.xls")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(6, 1) = "i"
For i = 0 To gridrow
grid1.Row = i
For j = 0 To 6
Grid1.Col = j

If IsNull(Grid1.Text) = False Then
xlSheet.Cells(i + 5, j + 1) = Grid1.Text
End If
Next j
Next i
Exit Sub