[VBA]別マクロを呼び出した結果を別形式で保存することができない

前提

VBA初心者の教師です。
【目標】
Wordで作成した学習プリント（解答部分は赤字で入力済み）のファイルを、欠席した生徒や反転学習したい生徒のために、.pdf形式で解答例(赤字)入りのプリントと、配布用の解答例の赤字を白字に置換したプリントの二つそれぞれで保存し、Webにアップロードしたいと思っています。
（白字にしたpdfファイルでもテキストコピーで答えがわかってしまうのは気にしないこととしています。）
【現在の状況】
同じフォルダ内に、マクロ実行用の.docmファイルと、大量にある学習プリントの.docxファイルが入っています。
全てのマクロは標準モジュール内に記載。

実現したいこと

.docmファイルに記載してあるマクロ「ConvertWordToPDFW」を実行し、同じフォルダ内のすべての.docxファイルに以下の処理を行う。

1.ファイルを非表示状態で開く
2.赤字を白字に置換するマクロ「R⇒W」を呼び出して実行（本文とテキストボックス内の両方を対象としている。）
3.実行後の内容を上書き保存後.pdf形式で別形式同名保存

発生している問題・エラーメッセージ

【うまくいったこと】
・フォルダ内にあるすべての.docxファイルが.pdf形式で保存できている
・②の内容（「R⇒W」マクロ）単体で実施した時は、想定通り本文とテキストボックスの赤字が白字に置換されている。
・エラーメッセージは出ていない。
【できていないこと】
・実行後の.docxファイルと.pdfファイルともに②のマクロの内容が反映されていない。

該当のソースコード

VBA
1Sub ConvertWordToPDFW()
2    Dim objDoc As Document
3    Dim strFile As String
4    Dim strPath As String
5    
6    strPath = ActiveDocument.Path & "\" '現在開いているドキュメントのパス
7    strFile = Dir(strPath & "*.docx") '拡張子が.docxのファイルを取得
8    
9    Do While strFile <> ""
10        
11        Set objDoc = Documents.Open(FileName:=strPath & strFile, Visible:=False) 'ファイルを開く
12        Call R⇒W '別マクロを実行
13        objDoc.Save
14        objDoc.SaveAs FileName:=Left(objDoc.FullName, InStrRev(objDoc.FullName, ".") - 1) & ".pdf", FileFormat:=wdFormatPDF ' pdf形式で保存
15        objDoc.Close 'ファイルを閉じる
16        strFile = Dir() '次のファイルを取得
17
18    Loop
19    
20    MsgBox "処理を終了しました。"
21       
22End Sub
23

呼び出している「R⇒W」のコード

VBA
1Sub R⇒W()
2'
3' R⇒W Macro
4'
5'
6    Selection.Find.ClearFormatting
7    Selection.Find.Font.Color = wdColorRed
8    Selection.Find.Replacement.ClearFormatting
9    Selection.Find.Replacement.Font.Color = -603914241
10    With Selection.Find
11        .Text = ""
12        .Replacement.Text = ""
13        .Forward = True
14        .Wrap = wdFindContinue
15        .Format = True
16        .MatchCase = False
17        .MatchWholeWord = False
18        .MatchByte = False
19        .MatchAllWordForms = False
20        .MatchSoundsLike = False
21        .MatchWildcards = False
22        .MatchFuzzy = True
23    End With
24    Selection.Find.Execute Replace:=wdReplaceAll
25    
26    
27     
28    'Shapeオブジェクトに対しても置換実行
29    Dim i As Integer
30    For i = 1 To ActiveDocument.Shapes.Count
31 
32        ActiveDocument.Shapes(i).Select
33    
34    Selection.Find.ClearFormatting
35    Selection.Find.Font.Color = wdColorRed
36    Selection.Find.Replacement.ClearFormatting
37    Selection.Find.Replacement.Font.Color = -603914241
38    With Selection.Find
39        .Text = ""
40        .Replacement.Text = ""
41        .Forward = True
42        .Wrap = wdFindContinue
43        .Format = True
44        .MatchCase = False
45        .MatchWholeWord = False
46        .MatchByte = False
47        .MatchAllWordForms = False
48        .MatchSoundsLike = False
49        .MatchWildcards = False
50        .MatchFuzzy = True
51    End With
52    Selection.Find.Execute Replace:=wdReplaceAll
53    
54    Next i
55    
56End Sub
57

回答1件

ベストアンサー

操作するWordを非表示で開いていますので、対象のWordファイルがActivateにならなかったためだと思われます。
非表示で開いたWordではなく、マクロを実行するWordに対して R⇒W() が実行されているみたいです。
試しにマクロを実装したWordに、赤文字を書き込んでみると、白になるはずです。
また、Visible:=True でWordを開くとご希望通りの動作をすると思います。

個人的にはActiveを使った操作は避けていますが、今回はそれを前提として

vba(Word)
1        Set objDoc = Documents.Open(FileName:=strPath & strFile, Visible:=False) 'ファイルを開く
2        Call R⇒W '別マクロを実行

の部分に、操作する非表示で開いたWordをActivateにする1行を追加して

vba(Word)
1        Set objDoc = Documents.Open(FileName:=strPath & strFile, Visible:=False) 'ファイルを開く
2        objDoc.Activate    ' ← 追加
3        Call R⇒W '別マクロを実行