起舞

普通单面打印机，变身成为双面打印机，特别适合多文档双面打印，一般打印机的纸张容量是150张，默认定义的是100张纸，先打奇数页，当打应的纸张大于100张时，将打印的纸张翻面重新放入打印机，会打印偶数页。

Sub 多文档同步正反面打印()

Dim mypath, wApp, wdDoc, doc

Dim s, i, j, k, l, m, n, dx, sums, jisu, count As Integer

Dim pageid, MyFile, Arr(1000) As String

'选择目录

With Application.FileDialog(msoFileDialogFolderPicker)

    If .Show = False Then Exit Sub

    mypath = .SelectedItems(1) & ""

End With

'遍历,将文件的名字存在数组中

MyFile = Dir(mypath & "*.doc*")

count = count + 1

Arr(count) = MyFile

Do While MyFile <> ""

    MyFile = Dir

    If MyFile = "" Then

        Exit Do

    End If

    count = count + 1

    Arr(count) = MyFile

Loop

'定义已打总页数

sums = 0

'定义偶数页倒打到第几个文档，初始倒打到1

dx = 1

MsgBox ("开始打印，请将出纸口清空。")

'新建一个空白文档

Set doc = Documents.Add

For n = 1 To count

    Set wdApp = New Word.Application

    Set wdDoc = wdApp.Documents.Open(mypath & Arr(n))

    '取得总word页数

    s = wdDoc.ActiveWindow.Panes(1).Pages.count

    '如果只一页，直接打印

    If s = 1 Then

        wdDoc.PrintOut Range:=wdPrintRangeOfPages, Pages:="1"

        sums = sums + 1

    End If

    '如果一个文档有多页，需要打双面，先打奇数页

    If s > 1 Then

        '判总数是否奇数页

       If Int(s / 2) = s / 2 Then

           jisu = 0

       Else

           jisu = 1 '是

       End If

       '奇数页打印

        For i = 1 To s

            pageid = i

            '先打奇数页

            If Int(i / 2) = i / 2 Then

            Else

                sums = sums + 1

                wdDoc.PrintOut Range:=wdPrintRangeOfPages, Pages:=pageid

            End If

        Next

    End If

    '退出

    wdDoc.Close False

    '当单面打印大于XX张时，开始提示打另一面（偶数面）

    If sums > 100 Or n = count Then

        MsgBox ("开始打印另一面，请将打印完成的纸张重新放入打印机。")

        '文档倒序然后打偶数页

        For l = n To dx Step -1

            '打开文档

            Set wdDoc = wdApp.Documents.Open(mypath & Arr(l))

            '取得总word页数

            s = wdDoc.ActiveWindow.Panes(1).Pages.count

            '如果只有一页，打印空白页

            If s = 1 Then

                doc.PrintOut

            End If

            '多页

            If s > 1 Then

                '判总数是否奇数页

                If Int(s / 2) = s / 2 Then

                    jisu = 0

                Else

                    jisu = 1 '是

                End If

                '如果是文档总页数为奇数，先发送一份空白页

                If jisu = 1 Then

                    doc.PrintOut

                End If

                '然后再倒着打偶数页

                For i = s To 1 Step -1

                    pageid = i

                    If Int(i / 2) = i / 2 Then

                        wdDoc.PrintOut Range:=wdPrintRangeOfPages, Pages:=pageid

                    Else

                    End If

                Next

                '关闭文档

                wdDoc.Close False

             End If

        Next

        '打完后重新定义偶数页倒打文档号

        sums = 0

        dx = n + 1

    End If

    wdApp.Quit

Next

doc.Close False

Set wdDoc = Nothing

Set wdApp = Nothing

End Sub