excel双面打印宏
发布网友
发布时间：2022-04-30 16:05
共5个回答
热心网友
时间：2022-06-27 01:12
第一：打开要进行双面打印的excel文件，按 ALT+F11 进入VB编辑环境，在左侧工程窗口下右健，选择“插入->模块”，命名为模块1，双击该模块，在右侧窗口输入如下代码：
Public StartPage As Integer, StepLong As Integer, Col As String, PageHeight As Single, OffSet As Integer
变量说明：StartPage 表示要打印的起始页，比如可以是1或2，分别表示要打印奇数页或偶数页。
StepLong 表示是连续打印还是非连续打印，比如可以是1或2，分别表示连续打印或奇偶打印。
Col 表示excel中要打印到的哪一列，比如可以是D或H，分别表示从A列打印到D列
或从A列打印到H列。
PageHeight 表示excel分页时每页的标准页高，其中纵向页高为669.75，横向页高为427.5。
OffSet 表示判定上一页的最后一行是否被excel自动分到下一页的依据，其中纵向依据
为5，横向依据为14，即当：累计总行高 - 标准页高 > 5 (su - PageHeight > 5) 或
累计总行高 - 标准页高 > 14 (su - PageHeight > 14) 时(其中su 表示累计总行高，
这个变量将在后面说明)，上一页的最后一行将被excel自动分到下一页中。
第二：在左侧工程窗口下右健，选择“插入->用户窗体”，在工程窗口下方属性窗口中为窗体命名为frmPrint ，在右侧窗体上绘制出两个命令按钮，分别命名为 ood 和 even 。
第三：在左侧工程窗口下右健，选择“插入->用户窗体”，在工程窗口下方属性窗口中为窗体命名为frmOrientation ，在右侧窗体上绘制出两个单选按钮和一个命令按钮，两个单选按钮分别命名为optPortrait 和optLandscape ，命令按钮命名为cmdOk 。
第四：双击工程窗口的frmPrint ，打开右侧窗体，双击ood按钮，进入ood的click事件中，编写如下代码：
Private Sub ood_Click()
StartPage = 1
StepLong = 2
Col = InputBox("请输入要打印的列字母，例如： H", "打印列选择", "H")
If Col = "" Then Col = "H"
Unload Me
Load frmOrientation
frmOrientation.Show
End Sub
双击even按钮，进入even的click事件中，编写如下代码：
Private Sub even_Click()
StartPage = 2
StepLong = 2
Col = InputBox("请输入要打印的列字母，例如： H", "打印列选择", "H")
If Col = "" Then Col = "H"
Unload Me
Load frmOrientation
frmOrientation.Show
End Sub
第五：双击工程窗口的frmOrientation ，打开右侧窗体，双击窗体，选择事件栏中的Activate ，在UserForm 的Activate 事件中，输入如下代码：
Private Sub UserForm_Activate()
optPortrait = 1
PageHeight = 669.75
OffSet = 5
End Sub
再次双击工程窗口的frmOrientation ，打开右侧窗体，双击cmdOk 按钮，进入cmdOk 的click 事件中，编写如下代码：
Private Sub cmdOk_Click()
If optPortrait Then
PageHeight = 669.75
OffSet = 5
Else
PageHeight = 427.5
OffSet = 14
End If
oe
Unload Me
End Sub
说明：其中oe 为模块1下的一个通用过程，下面将会说明。
第六：双击工程窗口的模块1，在右侧输入如下代码：
Sub oe()
Dim s() As Integer
Dim e() As Integer
ReDim Preserve s(1)
ReDim Preserve e(1)
s(1) = 1
ii = 1
Do While True
For j = 1 To Asc(UCase(Col)) - Asc("A") + 1
q = q & Trim(Cells(ii, j))
r = r Or Cells(ii, j).MergeCells
Next j
If q = "" And Not r Then
Exit Do
Else
q = ""
r = False
End If
ii = ii + 1
Loop
ii = ii - 1
i = 1
Do While i <= ii
su = su + Rows(i).RowHeight
If su - PageHeight > OffSet Then
su = 0
e(UBound(e)) = i - 1
ReDim Preserve s(UBound(s) + 1)
ReDim Preserve e(UBound(e) + 1)
s(UBound(s)) = i
Else
i = i + 1
End If
Loop
e(UBound(e)) = i - 1
For i = StartPage To UBound(s) Step StepLong
t = t & "$A$" & s(i) & ":$" & Col & "$" & e(i) & ","
Next i
t = Left(t, Len(t) - 1)
ActiveSheet.PageSetup.PrintArea = t
End Sub
说明：s() 为动态数组，表示某一页的起始行。()里的内容表示某一所指页，s() 的值表示该页首
行的位置。
e() 为动态数组，表示某一页的终止行。()里的内容表示某一所指页，e() 的值表示该页末
行的位置。
ii 为行变量。
j 为列变量。
q 为判定数据列内容是否为空。如果不为空，则继续判定下一行，否则结束循环并确定
出最后一行数据的位置。
r 为确定某个单元格是否合并的布尔变量。如果为真，则继续判定下一行，否则如果q
为空则结束循环并确定出最后一行数据的位置。
su 为累计总行高。用来判定每页的首行和末行的位置。
热心网友
时间：2022-06-27 01:13
这个问题主要在打印机上，而不是单靠excel双面打印宏能解决的。。
热心网友
时间：2022-06-27 01:13
先打印奇数页,然后在打印时选择打印机属性(文件菜单/打印/属性)，找页设置或布局等等之类的，选择页序"从后向前"或者自最末页打印等等这类的。不同的打印机此选项不完全相同。
把你打印过的纸反过来放进去(不用一张一张反过来)即可以开始打印了(注意,如果你的文件最后是奇数页应该把最后一张抽出来).
参考资料：http://www.officestudy.cn/club/viewthread.php?tid=335
热心网友
时间：2022-06-27 01:14
Sub 手动双面打印()
Dim Pages As Long
Dim myBottonNum As Integer
Dim myPrompt1 As String
Dim myPrompt2 As String
myPrompt1 = "在打印时发生错误，请检查你的打印机设置"
myPrompt2 = "请将出纸器中已打印好一面的纸取出并将其放回到送纸器中，然后按下""确定""，继续打印"
myPrompt3 = "请将出纸器中已打印好一面的纸取出去除最后一张后，将其放回到送纸器中，然后按下""确定""，继续打印"
Pages = ExecuteExcel4Macro("Get.Document(50)") '统计总页数
On Error Resume Next
If (Pages = 0) Then '如果为零，说明没有可打印内容，退出程序
MsgBox "Microsoft Excel 未发现任何可以打印的内容", 0 + 48
Exit Sub
End If
If (Pages = 1) Then '判断是否只有一页，如果是，只打印第一页，然后退出
ActiveSheet.PrintOut
If Err.Number = 1004 Then
MsgBox myPrompt1, 0 + 48 '提示用户发生打印错误
End If
Exit Sub
End If
For i = 1 To Pages Step 2 '设置循环，打印奇数页
ActiveSheet.PrintOut From:=i, To:=i
If Err.Number = 1004 Then
MsgBox myPrompt1, 0 + 48
Exit Sub
End If
Next i
If Pages Mod 2 = 0 Then
myBottonNum = MsgBox(myPrompt2, 1 + 48) '提示用户取出纸张，确认后继续打印
If (myBottonNum = 1) Then
For J = Pages To 2 Step -2 '打印偶数页
ActiveSheet.PrintOut From:=J, To:=J
Next J
End If
Else
myBottonNum = MsgBox(myPrompt2, 1 + 48) '提示用户取出纸张，确认后继续打印
If (myBottonNum = 1) Then
For J = Pages - 1 To 2 Step -2 '打印偶数页
ActiveSheet.PrintOut From:=J, To:=J
Next J
End If
End If
End Sub
热心网友
时间：2022-06-27 01:14
