彰化一整天的論壇

 找回密碼
 立即註冊
查看: 3781|回復: 16

如何一次將多個word檔案另存成PDF檔案

[複製鏈接]
發表於 2014-10-28 14:11:36 | 顯示全部樓層 |閱讀模式
在word 2007(含)以後的版本,可以直接將word另存成PDF檔案,這個功能不錯用,但是只可以一個檔案一個檔案另存成pdf檔,所以就寫了這支自動將您選取的word檔案轉換成PDF檔案。
convertPDF_01.jpg
1.連結到http://download.bestdaylong.com/f67.htm
等15秒下載[ConvertPDF.docm]
convertPDF_02.jpg
2.[啟用編輯]
convertPDF_03.jpg
3.[啟用內容]
convertPDF_04.jpg
4.點[選取檔案]
convertPDF_05.jpg
5.選取多個檔案(可以配合[Ctrl]或[Shift]鍵)/[碓定
convertPDF_07.jpg
6.[開始轉換PDF]
convertPDF_08.jpg
7.[確定]
convertPDF_09.jpg
8.轉換後的PDF檔案
convertPDF_10.jpg
9.點選[清除檔案名稱]
convertPDF_11.jpg
10.就會將之前選取的檔案列表清除


回復

使用道具 舉報

 樓主| 發表於 2021-4-27 10:51:29 | 顯示全部樓層
本帖最後由 imingho 於 2021-4-27 15:18 編輯
P85212452000 發表於 2021-4-27 04:48
彰化一整天的Blog” 您好:
您提供的” 整批將word檔案轉換成pdf” word檔
真的太強的,很感謝您的佛心提供 ...

您可以參考.
https://docs.microsoft.com/zh-tw/office/vba/api/word.headerfooter
HeaderFooter 物件(Word)

  1. Sub 修改頁首頁尾文字()
  2.     With ActiveDocument.Sections(1)
  3.      .Headers(wdHeaderFooterPrimary).Range.Text = "Header text"
  4.      .Footers(wdHeaderFooterPrimary).Range.Text = "Footer text"
  5.     End With
  6. End Sub
複製代碼

  1. Sub 修改頁尾文字換行()
  2.     ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "a" & Chr(13) & "b"
  3. End Sub
複製代碼
回復 支持 1 反對 0

使用道具 舉報

 樓主| 發表於 2021-5-1 21:44:07 | 顯示全部樓層
P85212452000 發表於 2021-4-27 04:48
彰化一整天的Blog” 您好:
您提供的” 整批將word檔案轉換成pdf” word檔
真的太強的,很感謝您的佛心提供 ...

底下是解說版本.
https://youtu.be/ztJDc-yz2Ys
【word網友問題】如何在頁首及頁尾加入文字(有聲版)
回復 支持 1 反對 0

使用道具 舉報

發表於 2021-4-27 04:48:47 | 顯示全部樓層
彰化一整天的Blog” 您好:
您提供的” 整批將word檔案轉換成pdf” word檔
真的太強的,很感謝您的佛心提供。

目前我想利用您的檔案進行修改。
想請教一下
1.      如果我想要將檔案名稱的前七碼”H02P001”放到頁首,請教要如何修改程式?
2.      我也想修改頁尾的修改日期,請教要如何修改程式?
我只大略知道應該在巨集中的反藍部分修改。
3.      關於Visual Basic,我目前只會利用錄製巨集的方式,如果我也想學習,請問我應該如何進入較為容易?

再次感謝您的佛心提供及協助
謝謝

問題二

問題二

我只大略知道應該在巨集中的反藍部分修改

我只大略知道應該在巨集中的反藍部分修改

問題一

問題一

檔名

檔名
回復 支持 反對

使用道具 舉報

發表於 2021-5-2 11:14:37 | 顯示全部樓層
您真的太強了,
頁首已利用您說的方式並且加入檔名前七字加入文字
---------------------------------------------------------------
      '輸入的文字為檔名左7字()
    headertext = Left(strFileName, 7)
   
    '修改頁首頁尾文字()
    With ActiveDocument.Sections(1)
     .Headers(wdHeaderFooterPrimary).Range.Text = headertext
    End With
------------------------------------------
頁尾比較複雜,我還得要想一下
真的太感溫了!!
回復 支持 反對

使用道具 舉報

發表於 2021-5-2 18:57:51 | 顯示全部樓層
抱歉,再請教一下,我是利用您的word檔"如何一次將多個word檔案另存成PDF檔案"原程式進行修改想法是利用您的檔案,開啟所要修改的文件後,然後利用搜尋的方式,找到頁尾Footer關鍵字,將不要的文字刪除,然後再將要的文字填入

但是依據修改的程式,跑出來都是去搜尋原本的"如何一次將多個word檔案另存成PDF檔案",所以加入的文字都跑到原始檔案中。
無法修改利用"選取檔案"開啟的檔案中

似乎ActiveDocument 都是指向"如何一次將多個word檔案另存成PDF檔案"
我要怎麼指到搜尋及修改後來開啟的檔案?

--------------------------------------------------------------------------------------------------------
    '搜尋與取代()
    ActiveDocument.ActivePane.View.SeekView = wdSeekCurrentPageFooter
        Selection.Find.Text = "Revised"

    'Delete date and Replace
    '刪除原先的修改日期
        Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend
        Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.TypeBackspace
        Selection.TypeParagraph
    'End With
    ' 貼上"Revised 2021/05/02" & Chr(13) & "修訂日期 2021/05/02"
        Dim A As String
        A = "Revised    2021/05/02" & Chr(13) & "修訂日期   2021/05/02"

Footer.PNG
2.我也想修改頁尾的修改日期,請教要如何修改程式.png
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2021-5-3 08:29:07 | 顯示全部樓層
本帖最後由 imingho 於 2021-5-3 08:30 編輯
P85212452000 發表於 2021-5-2 18:57
抱歉,再請教一下,我是利用您的word檔"如何一次將多個word檔案另存成PDF檔案"原程式進行修改想法是利用您 ...

您好,
    麻煩您上傳您修改過的檔案及範例檔案,還有張貼程式碼請貼全部並參考底下這篇張貼.


如何在discuz張貼程式碼
http://discuz.bestdaylong.com/thread-30239-1-1.html
(出處: 彰化一整天的論壇)




回復 支持 反對

使用道具 舉報

發表於 2021-5-3 13:22:09 | 顯示全部樓層
您好!
抱歉!!請參考!!
但是程式每次跑到
'刪除原先的修改日期
ActiveWindow.View.SplitSpecial = wdPanePrimaryFooter   
都會指向目前開啟的檔案"如何一次將多個word檔案另存成PDF檔案"
而不是修改目前想修改的ActiveDocument "HXXPXXX"檔案
謝謝


  1. Private Sub cmdGO_Click() '開始目標動作

  2.     Dim i, j
  3.    
  4.     i = 2
  5.     j = 2
  6.    
  7.     Dim chkNumber
  8.    
  9.     chkNumber = ThisDocument.chkNumber.Value
  10.    
  11.    
  12.     FileName = Word.ActiveDocument.Name
  13.    
  14.     f = Documents(FileName).Tables(2).Cell(i, 2)
  15.     f = Left(f, Len(f) - 2)
  16.     While f <> "" And i <= Documents(FileName).Tables(2).Rows.Count
  17.        '檢查檔案是否存在
  18.         'FullFileName = Documents(FileName).Path & "" & f & ".doc"
  19.         If Dir(f) <> "" Then
  20.             Documents.Open FileName:=f
  21.             
  22.             strFileName = Documents(f).Name
  23.             
  24.             If Mid(strFileName, Len(strFileName) - 4, 1) = "." Then
  25.                 strFileName = Left(strFileName, Len(strFileName) - 5)
  26.             Else
  27.                 strFileName = Left(strFileName, Len(strFileName) - 4)
  28.             End If
  29.             
  30.             If chkNumber = True Then
  31.                 strFileName = Format(i - 1, "000")
  32.             End If
  33.                   
  34.     '刪除原先的修改日期
  35.         ActiveWindow.View.SplitSpecial = wdPanePrimaryFooter
  36.         Selection.MoveDown Unit:=wdLine, Count:=2
  37.         Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend
  38.         Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
  39.         Selection.Delete Unit:=wdCharacter, Count:=1
  40.         Selection.TypeBackspace
  41.         Selection.TypeParagraph

  42.     ' 貼上"Revised 2021/05/02" & Chr(13) & "修訂日期 2021/05/02"
  43.         Dim A As String
  44.         A = "Revised    2021/05/02" & Chr(13) & "修訂日期   2021/05/02"
  45.         Selection.Text = A
  46.             
  47.           '存檔
  48.             Documents(f).Activate
  49.             Documents(f).Save
  50.             Documents(f).Close
  51.          
  52.         Else
  53.              MsgBox "檔案:" & f & "不存在,請查看是否有拼錯字"
  54.         End If
  55.         
  56.         i = i + 1
  57.         f = Documents(FileName).Tables(2).Cell(i, 2)
  58.         f = Left(f, Len(f) - 2)
  59.         DoEvents
  60.     Wend
  61.     MsgBox "執行完成", , "彰化一整天http://bestdaylong.com"
  62. End Sub
複製代碼




回復 支持 反對

使用道具 舉報

發表於 2021-5-3 15:27:49 | 顯示全部樓層
P85212452000 發表於 2021-5-2 11:14
您真的太強了,
頁首已利用您說的方式並且加入檔名前七字加入文字
-------------------------------------- ...
  1. Private Sub cmdGO_Click() '開始目標動作

  2.     Dim i, j
  3.    
  4.     i = 2
  5.     j = 2
  6.    
  7.     Dim chkNumber
  8.    
  9.     chkNumber = ThisDocument.chkNumber.Value
  10.    
  11.    
  12.     FileName = Word.ActiveDocument.Name
  13.    
  14.     f = Documents(FileName).Tables(2).Cell(i, 2)
  15.     f = Left(f, Len(f) - 2)
  16.     While f <> "" And i <= Documents(FileName).Tables(2).Rows.Count
  17.        '檢查檔案是否存在
  18.         'FullFileName = Documents(FileName).Path & "" & f & ".doc"
  19.         If Dir(f) <> "" Then
  20.             Documents.Open FileName:=f
  21.             
  22.             strFileName = Documents(f).Name
  23.             
  24.             If Mid(strFileName, Len(strFileName) - 4, 1) = "." Then
  25.                 strFileName = Left(strFileName, Len(strFileName) - 5)
  26.             Else
  27.                 strFileName = Left(strFileName, Len(strFileName) - 4)
  28.             End If
  29.             
  30.             If chkNumber = True Then
  31.                 strFileName = Format(i - 1, "000")
  32.             End If
  33.                         
  34.             
  35.       '輸入的文字為檔名左7字()
  36.     headertext = Left(strFileName, 7)
  37.    
  38.     '修改頁首頁尾文字()
  39.     With ActiveDocument.Sections(1)
  40.      .Headers(wdHeaderFooterPrimary).Range.Text = headertext
  41.     End With
  42.          
  43.             
  44.             
  45.             
  46.           '存檔
  47.             Documents(f).Activate
  48.             Documents(f).Save
  49.             Documents(f).Close
  50.         Else
  51.              MsgBox "檔案:" & f & "不存在,請查看是否有拼錯字"
  52.         End If
  53.         i = i + 1
  54.         f = Documents(FileName).Tables(2).Cell(i, 2)
  55.         f = Left(f, Len(f) - 2)
  56.         DoEvents
  57.     Wend
  58.     MsgBox "執行完成", , "彰化一整天http://bestdaylong.com"
  59. End Sub
複製代碼
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2021-5-3 15:55:34 | 顯示全部樓層
P85212452000 發表於 2021-5-3 13:22
您好!
抱歉!!請參考!!
但是程式每次跑到

麻煩您上傳您修改過的檔案及範例檔案,這樣我才能幫您偵錯。
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)

GMT+8, 2021-10-19 08:00 , Processed in 0.122688 second(s), 20 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回復 返回頂部 返回列表