【Wordマクロ】デフォルトフォルダ内の既存文書から新規文書作成

セミナーをする場合、「特定のフォルダ」のファイルを「【Wordマクロ】既存の文書から新規作成する 」で紹介したようにして新規ファイルとして開いています。

そうすれば、セミナー中にファイルの内容を変更してしまうことを回避できます。


ところが、毎回セミナー内容が違うので、この「特定のフォルダ」をセミナー毎に設定するのが面倒でした。

そこで、「特定のフォルダ」を簡単に設定できるようなマクロを作りました。



▼このマクロでできること

特定のフォルダを設定します。

設定したフォルダ内でWord文書を選択すると、この文書をもとにして新規ファイルを作成します。



▼マクロの解説

最初のマクロでは、特定のフォルダを設定します。

この設定では、情報をパソコンに保存する必要があります。今日設定した情報を明日も利用したいからです。

今回は、変数（フォルダのパス）を「定型句」に保存する手法を使ってみました。Wordマクロのちょっとした技です。

例えば、SkyDriveのマクロというフォルダを「Defフォルダ」という定型句の項目名で登録します。

すると、[挿入] タブの[クイックパーツ] にある[定型句] の「Defフォルダ」という項目に以下のように「マクロ」フォルダのパスが保存されます。






次のマクロで、ファイルを選択するダイアログボックスを表示させます。ダイアログボックスが表示されたときに、特定のフォルダの内容を表示します。

その中からファイルを選択すると、そのファイルから新規文書が作成されるという仕組みです。


▼マクロ

Sub デフォルトフォルダの設定()
　
　Dim myRange As Range
　Dim myAutoTextEntry As AutoTextEntry
　Dim NormalTemp As Template
　Dim blnExist As Boolean
　Dim myFD As FileDialog
　　　　
　Const myFolderName As String = "Defフォルダ"
　
　blnExist = False
　
　'現在文書のテンプレートを変数の保存先に指定（通常はNormal.dotm)
　Set NormalTemp = ActiveDocument.AttachedTemplate
　
　'myFolderName名の項目の定型句が存在するか確認
　For Each myAutoTextEntry In NormalTemp.AutoTextEntries
　　If myAutoTextEntry.Name = myFolderName Then
　　　blnExist = True
　　　Exit For
　　End If
　Next

　'存在しない場合、定型句の項目を作成する(空の文字列を登録）
　If blnExist = False Then
　　Selection.Collapse
　　Set myRange = Selection.Range
　　NormalTemp.AutoTextEntries.Add Name:=myFolderName, Range:=myRange
　End If

　'フォルダの選択
　Set myFD = Application.FileDialog(msoFileDialogFolderPicker)
　If myFD.Show = 0 Then Exit Sub

　'定型句の登録（値を入れています）
　NormalTemp.AutoTextEntries(myFolderName).value = myFD.SelectedItems(1)
　
　Set NormalTemp = Nothing
　Set myFD = Nothing
　
End Sub



Sub ファイル作成_デフォルトフォルダから()

　Dim myFD As FileDialog
　Dim myFolderPath As String
　Dim myAutoTextEntry As AutoTextEntry
　Dim NormalTemp As Template
　Dim blnExist As Boolean
　
　Const myFolderName As String = "Defフォルダ"

　If Application.Version < 11 Then
　　MsgBox "Word 2002以前では動作しません。"
　　Exit Sub
　End If

　blnExist = False

　'現在文書のテンプレートを変数の保存先に指定（通常はNormal.dotm)
　Set NormalTemp = ActiveDocument.AttachedTemplate

　'myFolderName名の項目の定型句が存在するか確認
　For Each myAutoTextEntry In NormalTemp.AutoTextEntries
　　If myAutoTextEntry.Name = myFolderName Then
　　　blnExist = True
　　　Exit For
　　End If
　Next
　
　'存在しない場合、終了します。
　If blnExist = False Then
　　MsgBox "デフォルトフォルダを設定してください。終了します。"
　　Exit Sub
　End If
　
　'最初に表示するフォルダパスを取得（定型句の情報を読み込む）
　myFolderPath = NormalTemp.AutoTextEntries(myFolderName).value

　'ファイルの選択ダイアログ
　Set myFD = Application.FileDialog(msoFileDialogFilePicker)

　With myFD
　　.AllowMultiSelect = False
　　
　　'最初に表示するフォルダを設定
　　.InitialFileName = myFolderPath
　　
　　With .Filters
　　　'ファイルの種類をクリア
　　　.Clear
　　　'ファイルの種類を追加
　　　.Add "Word文書", "*.doc; *.docx"
　　End With
　
　　If .Show = -1 Then
　　　Documents.Add Template:=.SelectedItems(1)
　　End If
　
　End With

　Set myFD = Nothing

End Sub


▼関連記事

【Wordマクロ】既存の文書から新規作成する