選択した文字列を別ファイルに出力する(Word 2007以降)

「指定した範囲を別文書としてエクスポートする(Word 2007以降)」で紹介しているコードを応用した、選択した文字列を別ファイルとして出力するマクロと、選択位置に別ファイルを挿入するマクロです。


                    Option Explicit

                    

                    Public Sub ExportDocumentFragment()

                    '選択文字列を別ファイルにエクスポートする

                      Dim FilePath As String

                      Dim tmp As String

                      

                      '選択文字列が改行と空白のみの場合は終了

                      tmp = Selection.Range.Text

                      tmp = Replace(tmp, vbCr, "")

                      tmp = Replace(tmp, "　", "")

                      tmp = Replace(tmp, " ", "")

                      If Len(tmp) < 1 Then Exit Sub

                      

                      With Application.FileDialog(msoFileDialogSaveAs)

                        If .Show Then

                          FilePath = .SelectedItems(1)

                        Else

                          Exit Sub

                        End If

                      End With

                      

                      Select Case LCase$(Mid$(FilePath, InStrRev(FilePath, ".") + 1))

                        Case "docx"

                          Selection.Range.ExportFragment FilePath, wdFormatDocumentDefault

                          MsgBox "「" & FilePath & "」に出力しました。", vbInformation + vbSystemModal

                        Case Else

                          MsgBox "現在「docx」形式にのみ対応しています。" & vbCrLf & "「docx」形式を選択してください。", vbExclamation + vbSystemModal

                      End Select

                    End Sub

                    

                    Public Sub ImportDocumentFragment()

                    '選択位置に別ファイルをインポートする

                      Dim FilePath As String

                      

                      With Application.FileDialog(msoFileDialogFilePicker)

                        .Filters.Clear

                        .Filters.Add "Word 文書", "*.docx"

                        .FilterIndex = 1

                        If .Show Then

                          FilePath = .SelectedItems(1)

                        Else

                          Exit Sub

                        End If

                      End With

                      Selection.Collapse wdCollapseEnd

                      Selection.Range.ImportFragment FilePath

                    End Sub