[分享][转]自动定义 Excel 的打印纸张

Alex

word可以简单的自定义纸张大小,但是EXCEL只能在打印机的可用纸张中的设置,

转个帖子给有需要的人

-----------------------------------------------------------------------

 在使用EXCEL表格中，经常需要把生成的大量数据打印出来。但如果要连续格式纸打印，页面设置中往往要进行自定义纸张。用手工定义，会出现不该分页时分页；数据打完了，打印机还要走行一段距离的情况。调整起来很不方便，数据量大时，既浪费纸张，又浪费时间。能否用程序来控制，即根据数据量的大小自动设置纸张的大小，达到准确走纸的目的？答案是肯定的。本人经过摸索，用VBA编制了一个小程序，实现目的。

以下是用VBA编的程序段：（OFFICE中，都要嵌套VBA）
------------------------------------------------------------------------------
Dim a,b,c,d,u,v,x,y
Dim m As DataObject
Set m = New DataObject '建立数据目标，便于将数据放入剪贴板
u=inputbox("请输入打印区域首行行号")
x=val(u) '转换为数值
v=inputbox("请输入打印区域末行行号")
y=val(v)
a=x ’从首行开始
Do 
a = a + 1 ’进行循环
b = Rows(a).RowHeight ’算出每一行的行高
s = s + b ’将行高求和 
Loop Until a = y ’末行循环结束

c = s * 3.5 + 300 ’打印机设置好后，表格行的高度之和与打印机实际走行的距离有一定的比例关系
d = Int? '取整
m.SetText (d) ’算出的高度赋给变量
m.PutInClipboard ’复制变量 
SendKeys "%" '打开文件菜单
SendKeys "{down}{down}{down}{down}{down}{down}{down}{down}{enter}"
 ’打开页面设置对话框
SendKeys "+{tab}{enter}" ’打开选项对话框 
SendKeys "{left}{right}" '打开纸张自定义对话框
SendKeys "{tab}" ’选择高度栏
SendKeys "^v" ’将需要设置的值粘贴进来
SendKeys "{tab}{tab}{enter}" ’关闭纸张自定义对话框
SendKeys "{tab}{tab}{tab}{tab}{tab}{enter}" '关闭选项对话框 节
SendKeys "{tab}{tab}{tab}{tab}{tab}{tab}{tab}{tab}{tab}{enter}" '关闭页面设置对话框
DoEvents '将控制权转移
Range(Cells(x, 1), Cells(y, 6)).Select ’选择打印区域
Selection.PrintOut ’开始打印

----------------------------------------------------------------------------------
应用步骤： 
1.将程序嵌入EXCEL的VBA中
打开EXCEL--选择工具菜单----下拉中选择宏---打开宏对话框----在宏名中任起一宏的名字--
--按创建按纽----在SUB（宏名字）与END SUB 之间将上述程序段拷贝进去---关闭VB编缉器.
2.执行宏.
工具菜单---宏-----宏对话框---选对应的宏----按执行按纽

注意事项：
1.以上程序在win98+office97下通过，打印机选LQ1600k仿真，支持连续格式纸打印。
2.如果是在OFFICE2000，或者其它打印机，上述程序只要稍作修改后，即可使用。
3.以上是一个自定义高度的例子，如果要自定义宽度，可根据例子自行修改。
4.本例中，用INPUTBOX函数设定首行与末行的行号，用来演示，在实际应用中，可以根据您的需要，用程序来设定。
5.如果有兴趣，或有什么问题，请来电：llhhee@sina.comt '建立数据目标，便于将数据放入剪贴板
u=inputbox("请输入打印区域首行行号")
x=val(u) '转换为数值
v=inputbox("请输入打印区域末行行号")
y=val(v)
a=x ’从首行开始
Do 
a = a + 1 ’进行循环
b = Rows(a).RowHeight ’算出每一行的行高
s = s + b ’将行高求和 
Loop Until a = y ’末行循环结束

c = s * 3.5 + 300 ’打印机设置好后，表格行的高度之和与打印机实际走行的距离有一定的比例关系
d = Int? '取整
m.SetText (d) ’算出的高度赋给变量
m.PutInClipboard ’复制变量 
SendKeys "%" '打开文件菜单
SendKeys "{down}{down}{down}{down}{down}{down}{down}{down}{enter}"
 ’打开页面设置对话框
SendKeys "+{tab}{enter}" ’打开选项对话框 
SendKeys "{left}{right}" '打开纸张自定义对话框
SendKeys "{tab}" ’选择高度栏
SendKeys "^v" ’将需要设置的值粘贴进来
SendKeys "{tab}{tab}{enter}" ’关闭纸张自定义对话框
SendKeys "{tab}{tab}{tab}{tab}{tab}{enter}" '关闭选项对话框 节
SendKeys "{tab}{tab}{tab}{tab}{tab}{tab}{tab}{tab}{tab}{enter}" '关闭页面设置对话框
DoEvents '将控制权转移
Range(Cells(x, 1), Cells(y, 6)).Select ’选择打印区域
Selection.PrintOut ’开始打印

----------------------------------------------------------------------------------
应用步骤： 
1.将程序嵌入EXCEL的VBA中
打开EXCEL--选择工具菜单----下拉中选择宏---打开宏对话框--

龙行天下8888

这个也要学习

football

学习了

昨天是我生日

满实用的 谢谢分享

cityhunter

QUOTE:

以下是引用Alex在2007-8-27 1:28:09的发言：

word可以简单的自定义纸张大小,但是EXCEL只能在打印机的可用纸张中的设置,

转个帖子给有需要的人

 

谢谢分享

我就是那个需要的人啊

牙痒痒

太感谢了，我想我就是那个特别需要的人，谢谢

牙痒痒

菜鸟请教，运行到第三步就提示出错了，在网上找了半天也没找到解决的办法，请高手指点迷津，谢谢