Q&A
前提
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件
下記のような回答は推奨されていません。
このような回答には修正を依頼しましょう。
2023/01/29 08:22 編集
2023/01/29 08:28