JohnD59 / work

0 stars 0 forks source link

第三顆按鈕---按照法院列印 #19

Open JohnD59 opened 1 year ago

JohnD59 commented 1 year ago
Sub PrintDocuments()
    Dim fileToOpen As Variant
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdSec As Object
    Dim wdHdr As Object
    Dim searchStr1 As String
    Dim searchStr2 As String
    Dim searchStr3 As String
    Dim searchStr4 As String
    Dim i As Long
    Dim t As Long

    fileToOpen = Application.GetOpenFilename(filefilter:="文檔 (*.doc*), *.doc*", _
        FilterIndex:=4, Title:="請選擇要處理的文檔(可多選)", MultiSelect:=True)

    If Not IsArray(fileToOpen) Then
        MsgBox "你沒有選擇文件", vbOKOnly, "提示"
        Exit Sub
    Else
        ' 初始化Word應用程式
        Set wdApp = CreateObject("Word.Application")
        wdApp.Visible = False ' 隱藏Word應用程式視窗

        t = 0

        For Each file In fileToOpen
            Set wdDoc = wdApp.Documents.Open(file)

            For Each wdSec In wdDoc.Sections
                Set wdHdr = wdSec.Headers(1)
                searchStr1 = "臺中"
                searchStr2 = "臺南"
                searchStr3 = "高雄"
                searchStr4 = "屏東"
                If InStr(wdHdr.Range.Text, searchStr1) > 0 Then
                    wdDoc.PrintOut Copies:=5 ' 列印5份
                    Exit For ' 找到關鍵字后立即退出循環
                ElseIf InStr(wdHdr.Range.Text, searchStr2) > 0 Then
                    wdDoc.PrintOut Copies:=3 ' 列印3份
                    Exit For ' 找到關鍵字后立即退出循環
                ElseIf InStr(wdHdr.Range.Text, searchStr3) > 0 Then
                    wdDoc.PrintOut Copies:=2 ' 列印2份
                    Exit For ' 找到關鍵字后立即退出循環
                ElseIf InStr(wdHdr.Range.Text, searchStr4) > 0 Then
                    wdDoc.PrintOut Copies:=2 ' 列印2份
                    Exit For ' 找到關鍵字后立即退出循環
                Else
                    wdDoc.PrintOut Copies:=5 ' 其他,打印五份
                    Exit For ' 找到關鍵字后立即退出循環
                End If
            Next wdSec

            wdDoc.Close False
            Set wdDoc = Nothing ' 釋放文檔資源
            t = t + 1
        Next file

        ' 關閉並釋放資源
        wdApp.Quit
        Set wdApp = Nothing
    End If

    MsgBox "操作完成!" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"
End Sub