曾经写过这样的代码,你看看是否可以。代码节选如下:
在报表上右键菜单调用。
Dim Counter As Integer
Dim total As Integer
Dim A As Variant
Dim B As Boolean
Dim rep As Report
Dim c, d As Integer
Sub qishu()
'总页数为奇数的代码块
A = InputBox _
("输入1,将打印奇数页" + vbNewLine + "" + "输入2,将打印偶数页" + vbNewLine + "" + "输入3,将打印当前页", "请输入...")
If A <> "" Then '如果inputbox 不返回一个空字符串,即用户输入任意内容
B = IsNumeric(A)
Select Case B
Case -1 '如果用户输入数字
Select Case A
Case 1 '如果用户输入数字1
'打印奇数页
For Counter = 1 To c Step 2
total = total + Counter
MsgBox "报表第" & Counter & "页将会被直接打印"
'*********************
' 在该过程被调用的时候,对打印机的设置已经完成,所以这里并不加入错误处理 _
而是在 使用docmd对象的openreport 方法来打开报表的时候使用错误处理 _
写在 open_report_err 模块中
DoCmd.printout acSelection, Counter, Counter, acHigh, 1, True
'********************
Next Counter
Case 2 '如果用户输入数字2
' 打印偶数页
For Counter = 2 To c - 1 Step 2
total = total + Counter
MsgBox "报表第" & Counter & "页将会被直接打印"
'*************************
' 在该过程被调用的时候,对打印机的设置已经完成,所以这里并不加入错误处理 _
而是在 使用docmd对象的openreport 方法来打开报表的时候使用错误处理 _
写在 open_report_err 模块中
DoCmd.printout acSelection, Counter, Counter, acHigh, 1, True
'************************
Next Counter
Case 3
DoCmd.printout acSelection, d, d, acHigh, 1, True
Case Else '如果用户输入的数字 不是1和2 中的任意一个的话
MsgBox "请输入数字1或者2"
End Select
Case 0 '如果用户输入 文本或者其他无效字符的话
MsgBox "输入了错误的打印选项,可能是文本或者其他无效字符"
End Select
Else '如果inputbox 返回一个空字符串,即用户 点击关闭 或者 取消按钮 或者 不输入任何内容点击了确定按钮
MsgBox "您取消了打印操作"
End If
End Sub
Function Activereports()
On Error GoTo Activereports_Err
' Dim rep As Report
' Dim c, d As Integer
' 返回指向活动报表。
Set rep = screen.ActiveReport
' MsgBox rep.Name & " is the active rep."
c = Reports(rep.Name).Pages '报表的总页数
d = Reports(rep.Name).Page '当前报表的页码
Debug.Print c, d
If c Mod 2 = 0 Then '总页数为偶数
Call oushu
Else
Call qishu
End If
Activereports_Exit:
Exit Function
Activereports_Err:
' MsgBox Error$
MsgBox "您的操作需要一个激活的报表,请打开一个激活的报表"
Resume Activereports_Exit
End Function
[此贴子已经被作者于2006-4-17 17:47:04编辑过]
|