ImpositionTool.bas
Attribute VB_Name = "ImpositionTool"
' 折手（Imposition）
' 在考虑版式和印后加工的前提下，将多个单独的页面安排到一个印张上（将文字、图形和图像安排到一个页面内，称为页面排版）。
'打印全部
Sub printAll()
Dim l_pages_count As Long, tmp_s As String
l_pages_count = Selection.Information(wdNumberOfPagesInDocument)
If l_pages_count Mod 4 > 0 Then Call setPageTo4Times
tmp_s = getPageSequance(1, l_pages_count)
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=tmp_s, _
PageType:=wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, _
Background:=False, PrintToFile:=False, PrintZoomColumn:=2, PrintZoomRow:=1 _
, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
End Sub
'调整页码为4的倍数
'
Sub setPageTo4Times()
Dim l_current_page As Long
Dim l_current_page2 As Long
Dim l_pages_count As Long
Dim l_tmp As Long
l_current_page = Selection.Information(wdActiveEndPageNumber)
l_pages_count = Selection.Information(wdNumberOfPagesInDocument)
l_tmp = l_pages_count Mod 4
If l_tmp >= 0 Then
Selection.EndKey Unit:=wdStory
l_current_page2 = Selection.Information(wdActiveEndPageNumber)
For i = 1 To 4 - l_tmp
Selection.InsertBreak Type:=wdPageBreak
Next
ActiveDocument.ActiveWindow.PageScroll Up:=(l_current_page2 - l_current_page) '+ 4 - l_tmp
End If
End Sub
' 返回折手页码顺序
' 一页纸正反2面各打印2页，共4页
' 0 表示此处需要打印空白页
Function getPageSequance(i_from As Long, i_to As Long) As String
Dim l_page_count As Long
Dim l_paper_count As Long
Dim l_p As Long, l_tmp As Long
If i_to >= i_from And i_from > 0 Then
getPageSequance = ""
l_page_count = i_to - i_from + 1
l_paper_count = CLng(l_page_count / 4)
If l_paper_count * 4 < l_page_count Then
l_paper_count = l_paper_count + 1
End If
getPageSequance = ""
For l_p = 1 To l_paper_count
l_tmp = 2 * l_p - 1
If l_tmp <= l_page_count Then
getPageSequance = getPageSequance & "," & CStr(l_tmp - 1 + i_from)
Else
getPageSequance = getPageSequance & ",0"
End If
l_tmp = 2 * (2 * l_paper_count + 1 - l_p)
If l_tmp <= l_page_count Then
getPageSequance = getPageSequance & "," & CStr(l_tmp - 1 + i_from)
Else
getPageSequance = getPageSequance & ",0"
End If
l_tmp = 2 * l_p
If l_tmp <= l_page_count Then
getPageSequance = getPageSequance & "," & CStr(l_tmp - 1 + i_from)
Else
getPageSequance = getPageSequance & ",0"
End If
l_tmp = 2 * (2 * l_paper_count - l_p) + 1
If l_tmp <= l_page_count Then
getPageSequance = getPageSequance & "," & CStr(l_tmp - 1 + i_from)
Else
getPageSequance = getPageSequance & ",0"
End If
Next
If Left$(getPageSequance, 1) = "," Then
getPageSequance = Mid$(getPageSequance, 2)
End If
Else
getPageSequance = ""
End If
End Function