Wordファイルに透かしを入れて、PDFに保存

Wordファイルを開いて、透かしを入れてPDFファイルに保存します。
透かしを入れる処理は、WordWatermark 関数で指定します。

Sub WordToPDFWatermark(filename As String)
	Dim WordApp As Word.Application
	Dim WordDoc As Word.Document
	Dim BasePathName As String
	                    
	' エラーが発生したらエラー処理へジャンプ
	On Error GoTo ErrorProc
	                    '
	' Wordオブジェクトの参照を作成
	Set WordApp = CreateObject("Word.Application")

	' Wordを表示する
	WordApp.Visible = True

	' 一時的に非表示
	Application.DisplayAlerts = False

	' Word のドキュメントを開く
	Set WordDoc = WordApp.Documents.Open(filename)

	Application.DisplayAlerts = True

	' 透かしを入れる
	WordWatermark WordApp, "Sample"


	' ファイルパス＋拡張子の無いファイル名を取得
	BasePathName = GetFileBasePathName(filename)


	' PDFファイルで保存
	WordDoc.ExportAsFixedFormat _
		OutputFileName:=BasePathName & ".pdf", _
		ExportFormat:=wdExportFormatPDF, _
		OpenAfterExport:=False, _
		OptimizeFor:=wdExportOptimizeForPrint, _
		Range:=wdExportAllDocument, _
		Item:=wdExportDocumentContent, _
		IncludeDocProps:=True, _
		KeepIRM:=True, _
		CreateBookmarks:=wdExportCreateHeadingBookmarks, _
		DocStructureTags:=True, _
		BitmapMissingFonts:=True, _
		UseISO19005_1:=False

	' Word を保存せずに閉じる
	WordDoc.Close SaveChanges:=False

	' 終了
	WordApp.Quit

	' オブジェクトを解放
	Set WordDoc = Nothing
	Set WordApp = Nothing

	' エラー処理前に終了
	Exit Sub

' エラー処理
ErrorProc:
	MsgBox "ファイルを開けません" & filename, vbExclamation

	' オブジェクトが有効な場合、終了処理
	If (WordApp Is Nothing) = False Then
		' 終了
		WordApp.Quit

		'オブジェクトを解放
		Set WordDoc = Nothing
	End If

End Sub

' Wordファイルに透かしを入れる
Sub WordWatermark(wdapp As Word.Application, msg As String)
	wdapp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
	' ワードアートの図形を描画キャンバスに追加
	wdapp.Selection.HeaderFooter.Shapes.AddTextEffect( _
		0, msg, "游明朝", 1, False, False, 0, 0).Select
	With wdapp.Selection.ShapeRange
		.Name = msg                                 ' 図形の名前
		.TextEffect.NormalizedHeight = False        ' すべての文字(大文字,小文字)を同じ高さにするか
		.Line.Visible = False                       ' 文字の輪郭
		.Fill.Solid                                 ' 塗りつぶしを均一な色
		.Fill.ForeColor.RGB = RGB(192, 192, 192)    ' 文字色
		.Fill.Transparency = 0.5                    ' 透明度 0.0 (不透明) から 1.0 (透明)
		.Rotation = 0                               ' z 軸回りの回転数
		.LockAspectRatio = True                     ' 縦横比を保持
		.Height = 300                               ' 高さ
		.Width = 300                                ' 幅
		.WrapFormat.AllowOverlap = True             ' 特定の図形の他の図形とオーバー ラップできるか
		.WrapFormat.Side = wdWrapNone               ' 図形のどちら側で折り返すか
		.WrapFormat.Type = wdWrapNone               ' 図形の折り返しの種類を設定
		.RelativeHorizontalPosition = _
			wdRelativeVerticalPositionMargin    ' 図形範囲の相対的な水平方向の位置を指定
		.RelativeVerticalPosition = _
			wdRelativeVerticalPositionMargin    ' 図形範囲の相対的な垂直位置を指定
		.Left = wdShapeCenter                       ' 水平方向の位置をポイント単位で設定
		.Top = wdShapeCenter                        ' 垂直方向の位置をポイント単位で設定
	End With
End Sub

Wordファイルに透かしを入れる処理のパラメータを変更することで、形を変化させることができるので、説明します。

wdapp.Selection.HeaderFooter.Shapes.AddTextEffect で図形を追加します。
第１引数（例：0）：テキストの効果（0～49を設定できます。変更して確認してみてください）
第２引数（例：msg）：ワードアートの文字列（ここでは関数の引数で渡しています）
第３引数（例：”游明朝”）：フォントの名前
第４引数（例：1）：フォントの大きさ（*1）
第５引数（例：False）：Trueの場合、フォントを太字にする
第６引数（例：False）：Trueの場合、フォントを斜体にする
第７引数（例：0）：図形の左端の位置を、描画キャンバスの左端からポイント単位で指定（*1）
第８引数（例：0）：図形の上端の位置を、描画キャンバスの上端からポイント単位で指定（*1）
*1：後で高さと幅を設定するため影響はない

参考 : https://learn.microsoft.com/ja-jp/office/vba/api/word.shapes.addtexteffect

第５引数（太字）、第６引数（斜体）にした場合