【Word VBA】特定ファイルの段落書式を取り込むWordマクロ

2018/05/09 本記事を改良しました。
【コード】特定ファイルの段落書式を取り込むWordマクロ(その2)

段落書式の設定を一括でするマクロの開発の依頼をいただくことがよくあります。

設定項目はお客様それぞれなのですが、「このWordファイルと同じ設定にしたい」という要望はいつも同じです。

このマクロでは、特定のファイルの段落設定を現在のファイルに自動で取り込みます。

このマクロでできること

現在のファイルの段落書式を、特定のファイルの設定と同じようにします。

このマクロでは段落書式のうち以下の項目だけを設定できます。

段落書式

段落書式

段落毎に書式が異なる場合でも、すべての段落において上記の項目は同じ値に統一されてしまいますのでご注意ください。

マクロの解説

テンプレート用のファイルを選択するダイアログボックスについては、記事「【コード】ファイル選択ダイアログボックスの工夫 」を参考にしました。

また、別のファイルから情報を取得する仕組みについては、記事「【コード】Wordファイルからスタイルを全てコピーするWordマクロ 」にも同じような記載があります。

マクロ


Sub 段落書式をコピーするマクロ()

 Dim myFilePath As String ' Wordファイルパス
 Dim myFD As FileDialog
 Dim myDoc As Document
 Dim myTempDoc As Document
 
 Set myFD = Application.FileDialog(msoFileDialogFilePicker)

 '------------------------------------------------
 'Wordファイルの選択
 '------------------------------------------------
 With myFD

  .AllowMultiSelect = False
  .Title = "Wordファイルを選択してください"

  With .Filters
   .Clear
   .Add "すべてのWordファイル", "*.doc; *.docx"
  End With

  If .Show = -1 Then
   myFilePath = .SelectedItems(1)
   .Filters.Clear
  Else
   .Filters.Clear
   Exit Sub
  End If

 End With

 '------------------------------------------------
 '段落書式をコピーする
 '------------------------------------------------
 If Dir(myFilePath, vbNormal) <> "" Then
  
  '現在の文書をmyDocオブジェクトに設定する
  Set myDoc = ActiveDocument
  
  'テンプレートファイルを開く
  '保護されたビューにならないように「読取り専用」で開く
  Set myTempDoc = Documents.Open(FileName:=myFilePath, ReadOnly:=True, Visible:=False)
   
  '-----------------------------------
  '段落書式設定
  '-----------------------------------
  With myDoc.Range.ParagraphFormat
  
   '-------------------------------------------
   '「インデントと行間隔」タブ
   '-------------------------------------------
   '「1ページの行数を指定時に文字を行グリッド線に合わせる」
   .DisableLineHeightGrid = myTempDoc.Range.ParagraphFormat.DisableLineHeightGrid
   
   '行間
   .LineSpacingRule = myTempDoc.Range.ParagraphFormat.LineSpacingRule
   
   '間隔
   .LineSpacing = myTempDoc.Range.ParagraphFormat.LineSpacing
   
   '段落後の間隔
   .SpaceAfter = myTempDoc.Range.ParagraphFormat.SpaceAfter
   
   '段落前の間隔
   .SpaceBefore = myTempDoc.Range.ParagraphFormat.SpaceBefore
   
   '-------------------------------------------
   '「体裁」タブ
   '-------------------------------------------
   '「禁則処理を行う」
   .FarEastLineBreakControl = myTempDoc.Range.ParagraphFormat.FarEastLineBreakControl
   
   '「英単語の途中で改行する」
   .WordWrap = myTempDoc.Range.ParagraphFormat.WordWrap
   
   '「句読点のぶら下げを行う」
   .HangingPunctuation = myTempDoc.Range.ParagraphFormat.HangingPunctuation
   
   '「日本語と英字の間隔を自動調整する」
   .AddSpaceBetweenFarEastAndAlpha = myTempDoc.Range.ParagraphFormat.AddSpaceBetweenFarEastAndAlpha
   
   '「日本語と数字の間隔を自動調整する」
   .AddSpaceBetweenFarEastAndDigit = myTempDoc.Range.ParagraphFormat.AddSpaceBetweenFarEastAndDigit
       
  End With
  DoEvents
  
  myTempDoc.Close SaveChanges:=wdDoNotSaveChanges
  DoEvents
  
  Set myTempDoc = Nothing
  Set myDoc = Nothing
  
 End If

 Set myFD = Nothing
 
End Sub

トップへ戻る