エクセルVBAでワード文書をPDF保存

質問

質問の仕方が悪かったようですので先日の質問
https://okwave.jp/qa/q9876787.html
を取り消し、再度質問させていただきます。

エクセル2016のワークシート上にオブジェクトの挿入でワードの文書ファイルをアイコンで貼り付けています。VBAでこの文書ファイルを開き、PDFとして保存しようと思います。
見よう見まねで以下のようなコードを書いてみまた。

'参照設定　Microsoft Word 16.0 Object Library
Sub test01()
Dim objWord As Word.Application
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Dim objDoc As Word.Document
Dim FileName As String

FileName = Application.GetSaveAsFilename(, "PDFファイル,*.pdf", , "PDF保存")
Set objDoc = Worksheets("Sheet1").OLEObjects(1).Verb(Verb:=xlVerbOpen)
objDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
objDoc.Close
End Sub

これで、文書ファイルは開くのですが、「オブジェクトが必要です」のエラーがでて、Set objDocがEmptyのままPDF保存ができません。どのように直せばいいのでしょうか？
ご教示ください。

回答No.3

kkkkkm · ベストアンサー

> すでに他のワードが開いている場合はいかがすればよろしいでしょうか？

多分ブックに挿入しているファイルを開いた時のWord文書の名前は
○○.xlsm 内の Word 文書
といったブック名を含んだ名前になっていると思います。
そのようなWord文書が他に開いていないとして

For i = 1 To objWord.Documents.Count
If objWord.Documents(i).Name Like ThisWorkbook.Name & "*" Then
objWord.Documents(i).ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
objWord.Documents(i).Close
If objWord.Documents.Count = 0 Then
objWord.Quit
End If
Exit For
End If
Next

ThisWorkbook.Name & "*内の*"
などでもいいと思います。

お礼

なんどもありがとうございます。
とても勉強になりました。
これからもご指導のほどよろしくお願い申し上げます。

補足

以下で思ったようにできました。
本当にありがとうございました。

Sub Test02()
Dim objWord As Word.Application
Dim FileName As String
FileName = Application.GetSaveAsFilename(, "PDFファイル,*.pdf", , "PDF保存")
Worksheets("Sheet1").OLEObjects(1).Verb xlVerbOpen
Set objWord = GetObject(Class:="Word.Application")
'Wordファイルが複数開いていてる対応
For i = 1 To objWord.Documents.Count
If objWord.Documents(i).Name Like ThisWorkbook.Name & "*" Then
objWord.Documents(i).ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
objWord.Documents(i).Close
If objWord.Documents.Count = 0 Then
objWord.Quit
End If
Exit For
End If
Next
End Sub

回答No.2

kkkkkm

一部無駄がありました。

Sub Test()
Dim objWord As Word.Application
Dim o As Object
Dim FileName As String

FileName = Application.GetSaveAsFilename(, "PDFファイル,*.pdf", , "PDF保存")
Set o = Worksheets("Sheet1").OLEObjects(1)
o.Verb xlVerbOpen
Set objWord = GetObject(Class:="Word.Application")
'Wordファイルが一個しか開いていない前提です。
objWord.Documents(1).ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
objWord.Documents(1).Close
objWord.Quit
End Sub

お礼

ありがとうございました！うまくいきました。
ただ、
'Wordファイルが一個しか開いていない前提です。
とありますが、すでに他のワードが開いている場合はいかがすればよろしいでしょうか？

回答No.1

kkkkkm

無駄がありそうな気もしますが、とりあえず動きます。

Sub Test()
Dim objWord As Word.Application
Dim objW As Word.Application
Dim o As Object
Dim FileName As String

Set objW = CreateObject("Word.Application")
Set objWord = GetObject(Class:="Word.Application")
FileName = Application.GetSaveAsFilename(, "PDFファイル,*.pdf", , "PDF保存")
Set o = Worksheets("Sheet1").OLEObjects(1)
o.Verb xlVerbOpen
'Wordファイルが一個しか開いていない前提です。
objWord.Documents(1).ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
objWord.Documents(1).Close
objWord.Quit
End Sub

お礼

ありがとうございます。
回答の方でやってみました。