#contents

*Word 関連情報 [#g9ac2d18]
**サンプルコード [#gcce819d]
***ページ単位でファイルに保存するマクロ [#oa872b89]
 ' ページ単位でファイルに保存するマクロ
 Sub PageToDoc()
     Dim strFilePath
     Dim strPageList
     Dim strPageArray
     Dim strPageFromTo
     Dim nPageFrom
     Dim nPageTo
     
     strFilePath = "D:\home\edu\word\test\page_" ' 保存先
     strPageList = "1,2-3,4,5-6,7"   ' ページ数の指定。
     strPageArray = Split(strPageList, ",")
     For Each strPageFromTo In strPageArray
         GetPageFromTo strPageFromTo, nPageFrom, nPageTo
         Debug.Print "nPageFrom = " & nPageFrom & ", " & "nPageTo = " & nPageTo
         SaveAsPageFromTo strFilePath, nPageFrom, nPageTo
     Next
     
 End Sub
 
 ' ページの開始と終了を求める
 Function GetPageFromTo(ByVal strPageFromTo, ByRef nPageFrom, ByRef nPageTo)
     Dim strPageArray
     strPageArray = Split(strPageFromTo, "-")
     
     nPageFrom = -1
     nPageTo = -1
     
     ' 要素数を求める
     nCount = UBound(strPageArray, 1) - LBound(strPageArray, 1) + 1
     If nCount = 1 Then
         nPageFrom = CInt(strPageArray(0))
         nPageTo = strPageArray(0)
     ElseIf nCount = 2 Then
         nPageFrom = CInt(strPageArray(0))
         nPageTo = strPageArray(1)
     End If
     
 End Function
 
 ' 指定ページをファイルに保存
 Function SaveAsPageFromTo(ByVal strFilePath, ByVal nPageFrom, ByVal nPageTo)
     For i = nPageFrom To nPageTo
         Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=i ' 指定ページに移動
         Selection.GoTo What:=wdGoToBookmark, Name:="\page"          ' ページを選択
         Selection.Copy                                              ' ページをコピー
         If i <> nPageFrom Then
             Documents.Open strFilePath & nPageFrom                  ' 既存の文書をオープン
             Selection.EndKey Unit:=wdStory                          ' 文書の最後に移動
         Else
             Documents.Add DocumentType:=wdNewBlankDocument          ' 新規に作成
         End If
         Selection.PasteAndFormat (wdPasteDefault)                   ' ページを貼り付け
         Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend ' 選択を解除
         If i <> nPageFrom Then
             ActiveDocument.SaveAs FileName:=strFilePath & nPageFrom ' 既存の文書を更新
         Else
             ActiveDocument.SaveAs FileName:=strFilePath & i         ' 新規に保存
         End If
         ActiveWindow.Close
     Next i
 End Function

*VBScript 関連情報 [#tdd35748]
**サンプル [#ad45123b]
***テキストファイルを連結するサンプル [#g784b348]

 ' AppendFile.vbs
 ' 使い方：
 ' 1. DIR_SRC にコピー元のファイルがあるフォルダ名を指定します。
 ' 2. DIR_DST にコピー先のフォルダ名を指定します。
 ' 3. FILE_ADD に追加するテキストファイルを記述します。
 ' 4. AppendFile.vbs をダブルクリックします。
 '    DIR_DST の場所に連結されたファイルが作成されます。
 ' 
 Const DIR_SRC = "D:\home\edu\VBScript\AppendFile\src" ' コピー元のフォルダ名
 Const DIR_DST = "D:\home\edu\VBScript\AppendFile\dst" ' コピー先のフォルダ名
 Const FILE_ADD = "D:\home\edu\VBScript\AppendFile\add.txt" ' 追加するテキストファイル
 
 AppendFile
 
 Sub AppendFile
      Dim fso
      Set fso = CreateObject("Scripting.FileSystemObject")
      Dim folder
      Set folder = fso.GetFolder( DIR_SRC )
      Dim strFileName ' コピー元のファイル名が入ります
      Dim txtFile1
      Dim txtFile2
      Dim txtFile3
      Dim strMargeText ' 文字列連結用変数
      For Each strFileName In folder.Files
          Set txtFile1 = fso.OpenTextFile( strFileName, 1, False )
          Set txtFile2 = fso.OpenTextFile( FILE_ADD, 1, False )
          strMargeText = txtFile1.ReadAll & txtFile2.ReadAll
          Set txtFile3 = fso.CreateTextFile( DIR_DST & "\" & fso.GetFileName(strFileName) , True)
          txtFile3.WriteLine( strMargeText )
      Next
 End Sub

#comment
//#comment
トップ   編集 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS