索引文字列の抽出 - Agrimas

2014 年 4 月 10 日
索引文字列の抽出
益永八尋
索引作成や目次作成のための文字列、ページ、行数の抽出を行い、Text ファイルとして
保存する。
文字列抽出のためのマクロ（VBA）のコードは下記の通りである。このマクロの実行は
【Ctrl+Z】のキ―操作で行えるようにしている。
【Ctrl+Z】のキ―操作で行えるようにする
ための手順は“Ⅰ.マクロを Ctrl+Z のキー操作で実行させるための手順”に示す。ただし、
手順は Microsoft Office Word 2007 の場合である。これ以外のバージョンでは多少異なる
ので注意が必要である。このプログラムでは下記のようにページ番号の抽出が可能な場合
と不可能な場合がある。単純にページ番号がついただけの書式の場合には、ページ番号の
取得が可能であるが、ページ番号に飾り（〇付、リボン付等）が付いた書式の場合はペー
ジ番号の取得はできません。下表に一覧表として示す。下表のページ書式は Word の書式で
す。ただし、ページ番号は Footer に表示される場合である。Header や余白にページ番号
を表示している場合にはコードの変更が必要である。
抽出した文字列、ページ番号、行数のデータは、当該文書があるフォルダにテキストデー
タとして日付付のファイル名で（Sakuin_Dat_20140410.txt）保存される。このファイル
は NotePad で見れます。
文字列を抽出するための VBA のコードは“Ⅲ.標準モジュール NewMacros のプログラ
ムコード”に示す。VBA のコードを VBA コードが記述できる場所にコピー＆貼り付けす
る。VBA コードが記述できる場所は“Ⅱ.VBA の記述場所作成手順”に示す。
ページ番号を取得できる
書式番号
ページ書式名
ページ番号の取得が不能
書式番号
ページ書式名
1
番号のみ 1
10
X/Y ページ太字の番号 1
2
番号のみ 2
11
X/Y ページ太字の番号 2
3
番号のみ 3
12
X/Y ページ太字の番号 3
4
ページ番号 1
13
図形付き ページの端氏折り
5
ページ番号 2
14
図形付き ボックス付き斜体 1
6
強調線 1
15
図形付き ボックス付き斜体 2
7
強調線 2
16
図形付き モザイク 1
8
強調線 3
17
図形付き モザイク 2
9
強調線 4
18
図形付き モザイク 3
42
かっこ 1
19
図形付き リボン
46
チルダ
20
図形付き 円
1
2014 年 4 月 10 日
48
細い線
21
図形付き 円周 1
53
太い線
22
図形付き 円周 2
54
大（色付き）1
23
図形付き 円周 3
55
大（色付き）2
24
図形付き 角丸四角形 1
56
大（色付き）3
25
図形付き 角丸四角形 2
26
図形付き 角丸四角形 3
27
図形付き 巻物
28
図形付き 三角形 1
29
図形付き 三角形 2
30
図形付き 星マーク
31
図形付き 正方形 1
32
図形付き 正方形 2
33
図形付き 正方形 3
34
図形付き 積み上げたページ 1
35
図形付き 積み上げたページ 2
36
図形付き 楕円
37
図形付き 矢印 1
38
図形付き 矢印 2
39
番号のみ 2 本線 1
40
番号のみ 2 本線 2
41
番号の未 3 本線
43
かっこ 2
44
タブ 1
45
タブ 2
47
ドット
49
縦方向のアウトライン 1
50
縦方向のアウトライン 2
51
上線 1
52
上線 2
57
大1
58
大2
2
2014 年 4 月 10 日
Ⅰ.マクロを Ctrl+Z のキー操作で実行させるための手順
①ここをクリック
図Ⅰ-1 手順 1
②ここをクリック
3
2014 年 4 月 10 日
③ここをクリック
図Ⅰ-2 手順 2
4
2014 年 4 月 10 日
図Ⅰ-3 手順 3
④ここをクリック
5
2014 年 4 月 10 日
⑤ここを下にスクロールする
図Ⅰ-4 手順 4
図Ⅰ-5 手順 5
6
2014 年 4 月 10 日
図Ⅰ-6 手順 6
⑦ここをクリックする
⑥ここをクリックする
図Ⅰ-7 手順 7
⑨ここをクリックする
7
2014 年 4 月 10 日
図Ⅰ-8 手順 8
⑩ここをクリックする
8
2014 年 4 月 10 日
Ⅱ. VBA の記述場所作成手順
Word を起動したときに作成される文書 1 のメニューに【開発】がない場合は、Word の
オプションで【開発】を表示させます。この手順は以下のとおりです。
図Ⅱ-1 手順 1
①
ここをクリックする
9
2014 年 4 月 10 日
図Ⅱ-2 手順 2
②
ここをクリックする
③
ここにチェックを入れる
する
図Ⅱ-3 手順 3
④
10
ここをクリックする
2014 年 4 月 10 日
図Ⅱ-3 手順 3
⑤ ここをクリックする
図Ⅱ-4 手順 4
⑥
ここをクリック
する
赤線の枠内が VBA のコードを記述する場所です。
11
2014 年 4 月 10 日
Ⅲ.標準モジュール
NewMacros のプログラムコード
Public strDrive As String
'ドライブ名
Public strFolder As String
'フォルダ名
Public Mika As Integer
Public Folder_Name(500) As String
'フォルダ名のリスト
Public Folder_Count As Integer
Public strPath As String
Sub Get_Sakuin_Dat()
'2014.4.10
'Word 文書から索引を作成するための文字列抽出を行い、Text ファイルに保存する。
'Text ファイルのファイル名は日付入りとする。
Dim I As Integer
Dim J As Integer
Dim a As Object
Dim b As Object
Dim strDat As String
Dim MyPath As String
Dim subFile_Name As String
Dim n As Integer
Dim M(1000) As Integer
Dim Mn As Integer
Dim Mg As Integer
Dim Mo As Integer
Dim Rn As Integer
Dim D As Integer
Dim strMika As Variant
Dim secStrt_Num(100) As Variant
Dim Page1(1000, 500) As Integer
Dim wdFile_Name As String
Dim Sakuin_Count As Integer
'------------------------------------------------------------On Error Resume Next
'--------------------------------'索引作成の対象文書がある Path に Sakuin_Dat_" & subFile_Name & ".txt"があるか
を確認する
12
2014 年 4 月 10 日
strPath = ActiveDocument.Path
Sakuin_Count = Data_Read(strPath)
Sakuin_Count = Sakuin_Count + 1
'--------------------------------I=1
J=1
wdFile_Name = ActiveDocument.Name
Set b = Documents(wdFile_Name).ActiveWindow.Selection
M(J) = b.End
K = ActiveDocument.Range(0, M(J)).Sections.Count
'Set c = ActiveDocument.Sections(K)
'-----------------------------------------'Mn = Selection.Information(wdActiveEndPageNumber)
'ド
キュメントの累計ページ数
Mn = b.Information(wdActiveEndPageNumber)
'
ドキュメントの累計ページ数
'SecPage(I) = Mn
'P = Section_TotalPage(K)
'Mg = Selection.Information(wdFirstCharacterLineNumber)
'ペー
ジ内の行番号
Mg = b.Information(wdFirstCharacterLineNumber)
'ペ
ージ内の行番号
'Mo = Selection.Information(wdNumberOfPagesInDocument)
'ド
キュメント全体のページ数
Mo = b.Information(wdNumberOfPagesInDocument)
'
ドキュメント内のページ数
'Mn = Mn - Section_TotalPage(K - 1) + secStrt_Num(K) - 1
secStrt_Num(K)
=
ActiveDocument.Range(0,
M(J)).Sections(K).Footers(wdHeaderFooterFirstPage - 1)
strMika
=
ActiveDocument.Range(0,
M(J)).Sections(K).Footers(wdHeaderFooterFirstPage - 1)
'---------------------------If strMika = "" Then
Else
13
2014 年 4 月 10 日
Rn = Len(strMika)
Mn = Left(strMika, Rn - 1)
'セ
クションの最初のページ番号
D
=
b.Selection.Information(wdActiveEndAdjustedPageNumber)
'ページ内の行番号
'Page1(I, J) = c.Footers(wdHeaderFooterPrimary)
'セクションのページ番号
'---------------------------------------------------------'検索文字列が英数字表記の文字列の処理
'If strIndex(I) <> Japanese Then
'Selection.MoveRight
Unit:=wdCharacter,
Count:=1,
Extend:=wdExtend
'strKensaku_Moji = Selection
'If Right(strKensaku_Moji, 1) = "" Then
'---------------'Page1(I, J) = Mo - secStrt_Num(K - 1) + 1
Page1(I, J) = D
Page1(I, J) = Get_PageNum(strMika)
'End If
'End If
'strPage2(K, J) = c.Footers(wdHeaderFooterFirstPage)
End If
'-------------------------------------'MsgBox (StrConv(J, vbUpperCase) & " P." & Page1(I, J)) & Chr(13) & " P2." &
Mn & " 行：" & Mg
'Set C = Nothing
Set b = Nothing
'----------------------------------------Set a = Selection
n = ActiveDocument.Range(0, a.End).Sections.Count
'文書のセクション数
Set a = ActiveDocument.Sections(n)
'--------------------------------------------------------------------------------------------Selection.Font.Color = wdColorRed
'選択した文字列の
色を赤色にする
strDat = Selection.Text
'選択した文字列
'MsgBox a.Headers(wdHeaderFooterPrimary)
14
'Header の中の
2014 年 4 月 10 日
文字列を表示
MsgBox " 索引文字列 = " & strDat & Chr(13) & "ページ番号 = " & Page1(I, J) &
Chr(13) & "行番号 = " & Mg
'----------------------------------------subFile_Name = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)
'------------------------------MyPath = strPath & "¥Sakuin_Dat_" & subFile_Name & ".txt"
Open MyPath For Append Access Write As #1
'------------------------------------Write #1, Sakuin_Count, strDat, Page1(I, J), Mg
Close #1
End
End Sub
Public Function Get_PageNum(AA As Variant)
Dim Rn As Integer
Dim cnt As Integer
Dim BB As String
Dim Page_Num As String
'-------------------------Page_Num = ""
BB = ""
Rn = Len(AA)
'-------------------------For cnt = 1 To Rn
BB = Mid(AA, cnt, 1)
Select Case BB
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
Page_Num = Page_Num & BB
Case Else
End Select
Next cnt
'----------------------Get_PageNum = Val(Page_Num)
End Function
15
2014 年 4 月 10 日
Public Function Data_Read(AA As String)
Dim MyPath As String
Dim Page1(10, 10) As Integer
Dim I As Integer
Dim J As Integer
Dim Mg As Integer
'-----------------------On Error GoTo ErrorHandler
I=1
J=1
'------------------------subFile_Name = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)
MyPath = AA & "¥Sakuin_Dat_" & subFile_Name & ".txt"
Open MyPath For Input As #1
'--------------------------Do While EOF(1) = False
Input #1, Sakuin_Count, strDat, Page1(I, J), Mg
Loop
'-------------Close #1
'--------------Data_Read = Sakuin_Count
Exit Function
ErrorHandler:
errNo = Err.Number
If errNo = 53 Then
Mika = 0
Else
Resume Next
End If
End Function
Sub ListUp_FolderList(FolderSpec As String)
16
2014 年 4 月 10 日
Dim Folder_Collection As Object
Dim Folder_List As Variant
Dim cnt As Integer
Dim Folder_Name(500) As String
'------------------------------------------------------------------Set Folder_Collection = CreateObject("Scripting.FileSystemObject") _
.GetFolder(FolderSpec).SubFolders
'---------------------------------------cnt = 0
'---------------------------------------For Each Folder_List In Folder_Collection
cnt = cnt + 1
Folder_Name(cnt) = Folder_List.Name
Next
'---------------------------------------Folder_Count = cnt
'---------------------------------------With UserForm1.ComboBox2
.Clear
'-------------------------For I = 1 To Folder_Count
.AddItem Folder_Name(I)
Next I
End With
'------------------------------End Sub
17