1
1. Word VBA による言語テクスト分析
この章では WordVBA によって開発したマクロプログラム集 TEXTOS-2 を使って、 Word 上で言語テクストを編集・分析します。一部の出力ではエクセルシートを使い ます。 標準モジュールの mdTextos_2 をクリックすると、以下の次のフォーム(fmTextos_2) が立ち上がります。ここに「説明」「色彩」「単語リスト」「検索置換」「分析」と いう 5 つのタブがあります。以下ではこれらのタブ内に配置したプログラムの機能に ついて説明します。 以下の「1.1.セキュリティレベル」と「1.2 汎用化」の設定を行うと、次のフォーム が立ち上がります。ここに「説明」「言語資料」「検索・置換」「言語分析」「テキ ストボックス」という 5 つのタブがあり、「テキストボックス」以外のタブの中にさ まざまな機能が収められています。以下では最初の 4 つのタブについて説明します。 最後の「テキストボックス」は出力用のスペースです。 ＊TEXTOS-2 は、最初のバージョンの TEXTOS をもとに処理を高速化し、出力を多色 化し、構造を簡素化しました。2
1.1. Word VBA の準備
1.1.1. セキュリティ
ー
レベル
Word の文書を処理するためのプログラム言語 VBA (Visual Basic for Application)は 「マクロ」というコードを記述することによってコンピュータにさまざまな動作をさ せる機能をもちます。マクロの機能は言語研究に有用ですが、一方、悪意をもった人 がこれを悪用すると、コンピュータを勝手に操作してデータを消去したりコンピュー タの設定を変えたりすることがあります。このような被害に遭わないように、しかし また正しい使い方までも禁止しないように、私たち利用者はよく理解して一部の設定 を変えなくてはなりません。 マクロプログラムは Word のセキュリティレベルが最高に設定されていると実行で きません。次の手順に従ってセキュリティレベルを１段階下げてください。 ＊「ファイル」→「オプション」→「セキュリティセンター」→「セキュリティセン ターの設定」→「マクロの設定」（これは Word 2010 の場合です。Word 2007 では「フ ァイル」→「オプション」を、「Office ボタン」→「Word のオプション」のように読みかえてくださ い。以下でも同様です。） 次にすべての Word ドキュメントでマクロプログラムが使用可能になるように設定 しましょう。はじめに「開発」タブを表示させます。 ＊「ファイル」→「オプション」→「基本設定」→「[開発]タブをリボンに設定する」をチェック
＊「開発」タブ→左端の Visual Basic→Visual Basic Editor」が立ち上がります。この操 作のショートカットは[Alt]+[F11]です。
3
1.1.2. 汎用化
次の手順に従ってプログラムを Visual Basic Editor の左上の Project Explorer の中にあ る Normal に登録すれば、すべての Word 文書で使用可能になります。
(1) ショートカット[Alt]+[F11]を同時に押して、Visual Basic Editor を立ち上げてくだ さい。
(2) 左上の Project Explorer の Project (Textos)のフォルダー「フォーム」、「標準モジ ュール」を開き、フォームの FrmTextos と標準モジュールの ModTextos を上にある Normal にドラッグ・アンド・ドロップします。
4 (3) 次に Textos_Start プログラムをクイックアクセスツールバーに加えましょう 。 ＊「ファイル」→「オプション」→「クイックアクセスツールバー」→「コマンドの 選択」：マクロ→Normal.TexosStart.TextosStart を選択→追加（必要ならば「変更」で ボタンのアイコンを変えます。）→OK その結果次のようなボタンが表示されます。 アンインストールするときは、次の手順に従ってください。 ＊クイックアクセスバーにアイコンを右クリックし、「クイックアクセスバーから削 除」をクリック。次に、Visual Basic Editor の P プロジェクトペインで該当部分を右ク
5 リックし「解放」してください。
1.1.3. 「開発」タブ
最初に「開発」タブをリボンに設定します。 ＊「ファイル」→「オプション」→「基本設定」→「[開発]タブをリボンに設定する」をチェック 次のようにリボンに「開発」のタブが表示されます。 上のようにリボンの「開発」タブの左端に「Visual Basic」のアイコンが見えます。こ れをクリックすると「Visual Basic Editor」が立ち上がります。この操作のショートカ ットは[Alt]+[F11]です。1.1.4. コード
プログラムは一連のコードによって作動します。はじめは簡単なコードの練習をしま しょう。
6
＊「開発」→Visual Basic, またはショートカット[Alt]+F11
はじめに全体の画面の構成を見ましょう。次の要素を確かめましょう。 画面全体の構成
タイトルバー 一番上の青い部分です。ここを選択してドラッグすることができ
ます。最小化、最大化（元に戻す・縮小）、閉じるのボタンがあ ります。
7 メニューバー ファイルからヘルプまでのメニューが並んでいます。 ツールバー さまざまな機能のショートカットとして使用します。 プ ロ ジ ェ ク ト エ クスプローラ 左上のペインでファイルやユーザーフォーム、標準モジュールな どが並びます。 プ ロ パ テ ィ ー ウ ィンドー 左下のペインで、現在選択されているオブジェクトのプロパティ ーを表示・設定します。 イ ミ デ ィ エ イ ト ウィンドー プログラムの動作中にストップして、変数の動きを見るときに使 います。表示されていないときは、＊「表示」→「イミディエイ ト・ウィンドー」
＊新しい文書を開き、[Alt]+F11 で Visual Basic Editor を立ち上げ、「挿入」→「標準 モジュール」を開きます。 ＊次のコードを入力します。 コード： Sub zikken01() Selection.TypeText "ABC" '出力 End Sub
8 ＊このコードを実行するには、ツールバーの「実行」ボタンを押します。ショートカ ットは[F5]です。 次がその結果です。
1.1.5. 繰り返しの制御文
「繰り返しの制御文」を使って段落に番号をつけるためのプログラムを作ります。 (1) 次のような 3 行を選択して新文書に貼り付けます。 ABC defghijklmn opqr(2) Visual Basic Editor(VBE) で、新文書の標準モジュールに次のコードを記入しま す。
9 Sub p21()
Dim Pc&, i& '段落数、作業用変数
Pc = ActiveDocument.Paragraphs.Count '段落数
For i = 1 To Pc '段落数まで繰り返す
ActiveDocument.Paragraphs(i).Range.Text = _
i & vbTab & ActiveDocument.Paragraphs(i).Range.Text '現段落に段落番号を付与
Next i End Sub
10 《結果》 二重のネスト 連続する日本語文を WordVBA の Words(Index)コレクションを用いて単語に分割 します。 Sub p22() '日本語文を語に分割
Dim Pc&, Dn$, Wc&, i&, j& '段落数、文書名、語、作業用変数 Pc = ActiveDocument.Paragraphs.Count '段落数 Dn = ActiveDocument.Name '現文書名 Documents.Add '新文書を加える For i = 1 To Pc '段落数まで繰り返す Wc = Documents(Dn).Paragraphs(i).Range.Words.Count '現段落の語数 For j = 1 To Wc '語数まで繰り返す Selection.TypeText _ Documents(Dn).Paragraphs(i).Range.Words(j).Text & "/" '/を付与 Next Next End Sub 実行： 次の文を新文書に書き込み、p22 を実行します。
11 Hay un coche blanco a la puerta.
門のところに白い車が 1 台止まっている。
結果：
Hay /un /coche /blanco /a /la /puerta/./
/門/の/ところ/に/白い/車/が/1/台/止まって/いる/。/
1.1.6. ユーザーフォーム
コードだけでもプログラムを実行できますが、ユーザーフォームにコードを結び付け ておくと、さらにプログラムが使いやすくなります。 ＊「挿入」→「ユーザーフォーム」 コード画面に戻るには、エクスプローラの「コードの表示」ボタン、または F7。再び オブジェクト画面に戻るには、エクスプローラの「オブジェクトの表示」ボタン、ま たは[Shift]+F7。 ユーザーフォームの起動させるには、標準モジュールに次を書き込みます。12 コード： Sub UserFormShow() 'ユーザーフォーム UserForm1.Show 'ユーザーフォームを立ち上げる End Sub 《実行》 ツールボックス 次の「ツールボックス」を表示します。 コントロールには、「ラベル」「テキストボックス」「コンボボックス」「リストボ ックス」「チェックボタン」「オプションボタン」「トグルボタン」「フレーム」「コ マンドボタン」「タブストリッ婦」「マルチページ」「スクロールバー」「スピンボ タン」「イメージ」があります。 ＊次のように 2 つのコマンドボタンを配置します。
13 ＊CommandButton1 をダブルクリックすると、次のコード画面が現れます。 ＊カーソルの位置に次のコードを書き込みましょう。 コード： Selection.TypeText "ABC" '出力 ＊次を実行します。F5, F5, F5, ストップ（右上の X 印） 結果： ABCABCABC 標準モジュールにコードを記入します。
14 CommandButton2 をダブルクリックし、カーソルの位置に次のコードを入れます。 コード： End
1.1.7. マクロの記録
「マクロの記録」の作業を通して文書を装飾するためのコードを調べましょう。はじ めに次のような文を新文書に書き込みます。Hay un coche blanco a la puerta. 次を実行しましょう。
＊「開発」→「マクロの記録」
＊「blanco」を緑色の蛍光ペンでマークします。
Hay un coche blanco a la puerta.
門のところに白い車が 1 台止まっている。 ＊「開発」→「記録終了」
この操作のコードは VBE のプロジェクトエクスプローラの Normal の標準モジュー
15 Sub p23() ' ' Macro1 Macro ' '
Selection.MoveRight Unit:=wdCharacter, Count:=6, Extend:=wdExtend Options.DefaultHighlightColorIndex = wdBrightGreen
Selection.Range.HighlightColorIndex = wdBrightGreen End Sub
次に、一定の記号で囲まれた文字列の装飾を「置換」の機能を用いて変更します。
16 1. 検索する文字列に、¥(¥((*)¥)¥)を記入します。 2. 置換後の文字列に¥1 を記入します。 3. オプションボタンをおし、オプションの画面を開きます。 4. ワイルドカードを使用する、をチェックします。 5. 「書式」ボタンを押し、「置換後の文字」の「フォント」のスタイルを「斜体」に します。 結果：
Hay un coche blanco a la puerta.
この動作のコードをマクロの記録によって調べましょう。 Sub p23b() '文字装飾 ActiveDocument.Content.Copy '現文書をコピー Documents.Add.Content.Paste '新文書を加えてペースト With ActiveDocument.Content.Find '現文書の内容を検索 .ClearFormatting 'フォーマットを初期化 .Replacement.ClearFormatting '置換フォーマットを初期化 .Text = "¥(¥((*)¥)¥)" '検索文字列
17 .Replacement.Text = "¥1" '置換文字列 .Replacement.Font.Italic = True .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True .Execute Replace:=wdReplaceAll '全部変換 End With End Sub Word の検索フォームのオプションは、次のコードに対応します。 MatchCase 大文字と小文字を区別する(H) MatchWholeWord 完全に一致する単語だけを検索する(Y) MatchWilCards ワイルドカードを使用する(U) MatchSoundsLike あいまい検索（英）(K) MatchAllWordForms 英単語の異なる活用形も検索する(W) MatchByte 半角と全角を区別する(M) MatchFuzzy あいまい検索（日）(J)
＊なお、MatchWilCards, MatchSoundsLike, MatchAllWordForms, MatchFuzzy は 1 つだけ しか使うことができません。
検索と置換
このWord の動作を利用して、次のようなプログラムを作成しましょう。
Sub p31WildCard() 'ワイルドカードによる検索 Dim strObj As String '現文書のテキスト Dim strSch As String 'インプットボックス
Options.DefaultHighlightColorIndex = wdBrightGreen 'ハイライトの色を明るい緑とする
18 strSch = InputBox("検索文字列を書いてください。") 'インプットボックス If strSch = "" Then End 'キャンセル With Selection.Find '選択範囲で検索 .ClearFormatting: .Replacement.ClearFormatting '検索・置換文字列の書式を削除 .Text = strSch '検索文字列 .Replacement.Text = "" '置換文字列
.Format = True: .Replacement.Highlight = True '書式を含む：ハイライト
.Forward = True: .Wrap = wdFindStop '検索を下方向に：末尾で検索終了 .MatchCase = True: .MatchByte = True '大・小文字を区別：全・半角文字を区別 .MatchWholeWord = False '単語の一部も検索 .MatchWildcards = False ‘ワイルドカード使用 .MatchAllWordForms = False '活用形検索をしない .MatchSoundsLike = False '類似単語検索をしない .MatchFuzzy = False '曖昧検索をしない .Execute Replace:=wdReplaceAll '全置換 .ClearFormatting '検索文字列の書式を削除 .Replacement.ClearFormatting '置換文字列の書式を削除 End With End Sub 実行：
19 結果：
(1:0) Cap. 1 (1:1) In principio creavit Deus caelum & terram. (1:2) Terra autem erat inanis & vacua: & tenebrae erant super faciem abyssi: & spiritus Dei ferebatur super aquas. (1:3) Dixitque Deus. Fiat lux. Et facta est lux. (1:4) Et vidit Deus lucem quod esset bona: & divisit lucem a tenebris:
実行：
結果：
(1:0) Cap. 1 (1:1) In principio creavit Deus caelum & terram. (1:2) Terra autem erat inanis & vacua: & tenebrae erant super faciem abyssi: & spiritus Dei ferebatur super aquas. (1:3) Dixitque Deus. Fiat lux. Et facta est lux. (1:4) Et vidit Deus lucem quod esset bona: & divisit lucem a tenebris:
1.1.8. VBScript オブジェクト
(a) 連想配列オブジェクト
Word VBA, Excel VBA に VBScript の「ディクショナリ」Scripting.Dictionary を生成し て連想配列を使うことができます。
Sub UserForm_Activate() 'ユーザーフォームを表示 Dim objDic As Object '連想配列オブジェクト Set objDic = CreateObject("Scripting.Dictionary") '連想配列オブジェクトを生成
End Sub
一般の配列では、配列のキーを 0 と正の整数を使いますが、連想配列では文字列を 使うことができます。（配列のアイテムは文字でも数値でもかまいません。）たとえ ば、上のコードのように objDic を生成すると、objDic("ABC") =123 のように文字列
20 ABC をキーとして、その位置にアイテム 123 を代入することができます。 言語データ分析では文字列の処理が中心となりますので、それをキーにすることが できればとても便利です。たとえば、連想配列にキーが存在しているか否かは Exists という関数を使います。これによって、リストにある文字列の有無を検索（サーチ） することなく、一瞬で判別でき、また、キーに関する情報をアイテムとして代入して おけば、それの取得も一瞬で可能になります。 (b) 正規表現オブジェクト
Word VBA, Excel VBA に VBScript の「正規表現」VBScript.RegExp を生成すれば、正 規表現による検索・置換ができます。
Option Explicit
Dim obj 正規表現 As Object
Sub 正規表現()
Set obj 正規表現 = CreateObject("VBScript.RegExp") '正規表現オブジェクト生成
obj 正規表現.Global = True '全体検索
MsgBox 正規表現置換$("{*}", "([{}()<>¥[¥]])", "¥$1") '括弧類に¥をつけてエスケープ
Set obj 正規表現 = Nothing '正規表現オブジェクト解放 End Sub
Private Function 正規表現置換$(ByVal 対象$, 検索$, 置換$) obj 正規表現.Pattern = 検索$ '検索パターン
正規表現置換$ = obj 正規表現.Replace(対象$, 置換$) '置換 End Function
上のように、正規表現置換の関数を用意しておくと、VBA の Replace 関数のように、 3 つの引数で置換ができます。
21
1.2. 説明
最初の「説明」のタブのページには次のコマンドとオプションがあります。 オブジェクト名 Caption または Value pg 説明 説明 lbl 説明 TEXTOS-2 WordVBA による… chk 文字色 文字色 chk 下線色 下線色 chk 蛍光色 蛍光色 chk 太字 太字 txt 文字色 文字色（前図では青色） txt 下線色 前図の青線 cmd 実行 ◎実行 cmd 消去 消去 cmd 復元 復元 このページでは下部にあるすべてのチェックボックス (chk)とコマンドボタン(cmd)は 可動しません(Enabled=False)。 Option Explicit '変数を明示22 (ByVal H%, ByVal L%, ByVal S%) 'RGB 関数
Private Declare Sub ColorRGBToHLS Lib "SHLWAPI.DLL" _ (ByVal clrRGB&, H%, L%, S%) 'HLS サブルーチン
Dim obj 照合配列 As Object, obj 連想配列 As Object Dim obj 正規表現 As Object, Match, Matches
Dim obj エクセル As Object, obj クリップボード As New DataObject
Dim lngRGB&, HexRGB$ '長整数型 RGB 値、16 進数 RGB 値 Dim 蛍光色配列$(), 開始時間 Dim 出力文字数&, 出力文字列$, 追加文字列$ Dim 単語配列$(), 単語 v, 作業文字列$ Dim 選択範囲$, 段落配列$(), 段落 v, 段落番号& Dim 検索式配列$(), 検索式 v, 検索文字$, 置換文字$ これらの関数や変数については以下で（「色彩」「単語リスト」「検索置換」「分析」） 説明します。連想配列オブジェクトと正規表現オブジェクトについては→「準備」 Sub UserForm_Activate() 'フォーム表示
Set obj 照合配列 = CreateObject("Scripting.Dictionary") Set obj 連想配列 = CreateObject("Scripting.Dictionary")
Set obj 正規表現 = CreateObject("VBScript.RegExp") obj 正規表現.Global = True '全体検索
obj 正規表現.MultiLine = False '複数行にマッチ
Set obj 正規関数 = CreateObject("VBScript.RegExp") obj 正規関数.Global = True '全体検索
obj 正規関数.MultiLine = False '複数行にマッチ
Set obj エクセル = CreateObject("Excel.Application")
蛍光色配列$ = Split("FFFFFF,000000,FF0000,FFFF00,00FF00," _ & "FF00FF,0000FF,00FFFF,FFFFFF,800000,808000,008000," _ & "800080,000080,008080,808080,C0C0C0", ",")
23 HexRGB$ = txt 文字色値
cbo 蛍光色.AddItem "蛍光色": cbo 蛍光色.AddItem "黒" cbo 蛍光色.AddItem "青": cbo 蛍光色.AddItem "水色" cbo 蛍光色.AddItem "明るい緑": cbo 蛍光色.AddItem "ピンク" cbo 蛍光色.AddItem "赤": cbo 蛍光色.AddItem "黄" cbo 蛍光色.AddItem "白": cbo 蛍光色.AddItem "濃い青" cbo 蛍光色.AddItem "青緑": cbo 蛍光色.AddItem "緑" cbo 蛍光色.AddItem "紫": cbo 蛍光色.AddItem "濃い赤" cbo 蛍光色.AddItem "濃い黄": cbo 蛍光色.AddItem "50%灰色"
cbo 蛍光色.AddItem "25%灰色": cbo 蛍光色.ListIndex = 0 '最初の項目を選択 ページ.Value = 0 '「説明」のタブを選択 End Sub 以下で使用するオブジェクト（照合配列、連想配列、正規表現、正規関数、エクセル） をセットし、蛍光色配列$と HexRGB$の初期値を代入し、cbo 蛍光色(→「色彩」）の コンボボックスの要素名を設定します。 Sub ページ_Change()
Select Case ページ.Value 'ページでケースを選択 Case 0 '説明
chk 文字色.Enabled = False: chk 蛍光色.Enabled = False chk 下線色.Enabled = False: chk 太字.Enabled = False cmd 実行.Enabled = False: cmd 消去.Enabled = False cmd 復元.Enabled = False
Case 1 To 3 '色彩、単語リスト、検索置換
chk 文字色.Enabled = True: chk 蛍光色.Enabled = True chk 下線色.Enabled = True: chk 太字.Enabled = True cmd 実行.Enabled = True: cmd 消去.Enabled = True cmd 復元.Enabled = True
Case 4 '分析
chk 文字色.Enabled = False: chk 蛍光色.Enabled = False chk 下線色.Enabled = False: chk 太字.Enabled = False cmd 実行.Enabled = True: cmd 消去.Enabled = True cmd 復元.Enabled = True
24 End Sub フォームのページの選択にしたがってフォームの下部にある各種のチェックボタンと コマンドボタンの可動性を設定します。 Sub cmd 実行_Click() Call 実行準備
Select Case ページ.Value 'ページでケースを選択 Case 1: Call ■色彩
Case 2: Call ■単語リスト Case 3: Call ■検索置換 Case 4: Call ■分析 End Select
cmd 実行.Caption = "●実行:" & Int(Timer - 開始時間) & "秒" End Sub
実行ボタンクリック時に、「実行準備」サブルーチンで範囲の指定を確認し、出力文 字に関する変数を初期化します。次に、それぞれのオプションボタンの選択に従って 対応するサブルーチンを呼び込みます。
Sub 実行準備()
開始時間 = Timer: cmd 実行.Caption = "○実行中": DoEvents
If Len(Selection) < 2 Then
If MsgBox("全範囲を選択しますか？", vbYesNoCancel, "範囲選択") = vbYes Then Selection.WholeStory '全範囲選択 Else Exit Sub '実行終了 End If End If 出力文字列$ = "": 出力文字数& = 0 '初期化 End Sub
Private Sub cmd 消去_Click()
25 '単語リストまたは検索置換であれば… ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges '新文書をセーブしない で閉じる End If If ページ.Value = 4 Then '分析であれば…
obj エクセル.ActiveWorkbook.Close SaveChanges:=False 'ブックをセーブしないで 閉じる
End If End Sub
開いた新文書（単語リストまたは検索置換）やエクセルシート（「分析」）をセーブ しないで閉じます。
Private Sub cmd 復元_Click() ActiveDocument.Undo '元に戻す End Sub
ショートカット Ctrl+Z と同じ動作をします。
Sub UserForm_QueryClose(Cancel%, CloseMode%) '×終了ボタン Set obj 照合配列 = Nothing
Set obj 連想配列 = Nothing Set obj 正規表現 = Nothing Set obj エクセル = Nothing
End '終了 End Sub
26
1.3. 色彩
言語データ分析の結果を表示するとき文字列の背景色や文字色を変えられると便利で す。はじめに色彩に使われる変数として、色相(Hue)・明度(Lightness)・彩度(Saturation) と、赤(Red)・緑(Green)・青(Blue)について確認しておきましょう。赤(R)・緑(G)・青 (B)は光の三原色です。1.3.1. 色彩の性質
以下で色彩について簡単に観察します。はじめに色相について見ます。次は、純色（明 度(L)=120・彩度(S)=240）で固定し、色相を 0 から 240 まで調節して背景色の赤(R)・ 緑(G)・青(B)の変化を 16 進数で観察した結果です。RGB 値には赤(R)・緑(G)・青(B) がそれぞれ 2 桁(00 ~ FF)、全部で 6 桁の 16 進数を使います。たとえば青(0000FF)の赤 (R)の値は 00 になり, 緑(G)の値は 00 になり, 青(B)の値が FF になります。 色相(H) 明度(L) 彩度(S) RGB 背景色 0 120 240 0000FF ＊＊＊＊ 20 120 240 0080FF ＊＊＊＊ 40 120 240 00FFFF ＊＊＊＊ 60 120 240 00FF80 ＊＊＊＊ 80 120 240 00FF00 ＊＊＊＊ 100 120 240 80FF00 ＊＊＊＊27 120 120 240 FFFF00 ＊＊＊＊ 140 120 240 FF8000 ＊＊＊＊ 160 120 240 FF0000 ＊＊＊＊ 180 120 240 FF0080 ＊＊＊＊ 200 120 240 FF00FF ＊＊＊＊ 220 120 240 8000FF ＊＊＊＊ 240 120 240 0000FF ＊＊＊＊ このように色相は 0（青）から始まり、240（青）まで続きます。途中の RGB 値が 0000FF – 00FFFF – 00FF00 – FFFF00 – FF0000 – FF00FF – 0000FF のように変化する円 環になります。 次に明度(L)の変化を観察しましょう。はじめに色相=0（青）で実験します。 色相(H) 明度(L) 彩度(S) RGB 背景色 0 0 240 000000 ＊＊＊＊ 0 20 240 00002B ＊＊＊＊ 0 40 240 000055 ＊＊＊＊ 0 60 240 000080 ＊＊＊＊ 0 80 240 0000AA ＊＊＊＊ 0 100 240 0000D5 ＊＊＊＊ 0 120 240 0000FF ＊＊＊＊ 0 140 240 2B2BFF ＊＊＊＊ 0 160 240 5555FF ＊＊＊＊ 0 180 240 8080FF ＊＊＊＊ 0 200 240 AAAAFF ＊＊＊＊ 0 220 240 D5D5FF ＊＊＊＊ 0 240 240 FFFFFF ＊＊＊＊ 明度(L)=0 では赤(R)・緑(G)・青(B)がすべてゼロなので、光の 3 原色がどれもゼロ であるために黒になります。一方、明度(L)=240 では光の 3 原色がどれも最大になる ので白になります。純色の青(0000FF)から上方向に黒(000000)に向かうとき、青の数値 が減っていきます。一方、純色の青(0000FF)から下方向に白(FFFFFF)に向かうときは 赤(R)と緑(G)が同じ値で増えていきます。 次に、青(0000FF)と赤(FF0000)の混色である「紫」(FF00FF)について、明度の変化を 観察しましょう。
28 色相(H) 明度(L) 彩度(S) RGB 背景色 200 0 240 000000 ＊＊＊＊ 200 20 240 2B002B ＊＊＊＊ 200 40 240 550055 ＊＊＊＊ 200 60 240 800080 ＊＊＊＊ 200 80 240 AA00AA ＊＊＊＊ 200 100 240 D500D5 ＊＊＊＊ 200 120 240 FF00FF ＊＊＊＊ 200 140 240 FF2BFF ＊＊＊＊ 200 160 240 FF55FF ＊＊＊＊ 200 180 240 FF80FF ＊＊＊＊ 200 200 240 FFAAFF ＊＊＊＊ 200 220 240 FFD5FF ＊＊＊＊ 200 240 240 FFFFFF ＊＊＊＊ 紫(FF00FF)から明度(L)を下げて黒(000000)に向かうとき、赤(R)と青(B)の値が同等に 減少して、最後は 000000（黒）となり、逆に、明度(L)を上げて白(FFFFFF)に向かう ときは、緑(G)の値が増加して、最後は FFFFFF（白）になります。 同様に、「青紫」（色相：220）について明度の変化を観察します。 色相(H) 明度(L) 彩度(S) RGB 背景色 220 0 240 000000 ＊＊＊＊ 220 20 240 15002B ＊＊＊＊ 220 40 240 430055 ＊＊＊＊ 220 60 240 400080 ＊＊＊＊ 220 80 240 5500AA ＊＊＊＊ 220 100 240 6A00D5 ＊＊＊＊ 220 120 240 8000FF ＊＊＊＊ 220 140 240 952BFF ＊＊＊＊ 220 160 240 AA55FF ＊＊＊＊ 220 180 240 BF80FF ＊＊＊＊ 220 200 240 D5AAFF ＊＊＊＊ 220 220 240 EAD5FF ＊＊＊＊ 220 240 240 FFFFFF ＊＊＊＊ 青紫(8000FF)から明度(L)を下げて黒(000000)に向かうとき、赤(R)と青(B)の値がその 割合に応じて同等に減少し、最後は 000000（黒）となり、逆に、明度(L)を上げて白
29 (FFFFFF)に 向 か う と き は 、 赤 (R)と 緑 (G)の 値 が そ の 割 合 に 応 じ て 増 加 し て 、 最 後 は FFFFFF（白）になります。 彩度(S)は、純色を最大(Max)として、同じ明度を保ちながら無彩色に至る度合い（灰 色が混じる度合い）を示します。無彩色の赤(R)・緑(G)・青(B)はすべて同じ値です。 黒(000000)と白(FFFFFF)は無彩色の中で、それぞれ明度が最小(0)と明度が最大(240)を 示します。「青」について彩度の変化を観察しましょう。 色相(H) 明度(L) 彩度(S) RGB 背景色 0 120 0 7F7F7F ＊＊＊＊ 0 120 20 75758A ＊＊＊＊ 0 120 40 6A6A95 ＊＊＊＊ 0 120 60 60609F ＊＊＊＊ 0 120 80 5555AA ＊＊＊＊ 0 120 100 4A4AB5 ＊＊＊＊ 0 120 120 4040BF ＊＊＊＊ 0 120 140 3535CA ＊＊＊＊ 0 120 160 2B2BD5 ＊＊＊＊ 0 120 180 2020DF ＊＊＊＊ 0 120 200 1414EA ＊＊＊＊ 0 120 220 0B0BF4 ＊＊＊＊ 0 120 240 0000FF ＊＊＊＊ このように、彩度を下げていくと（つまり、上表で上昇していくと）、指定された 明度が示す無彩色（灰色）の赤(R)・緑(G)・青(B)値(7F)に向かって、同じ割合でそれ ぞれの値が減少します。 次のように彩度がゼロであれば、明度に従って赤(R)・緑(G)・青(B)がすべて同値の まま増減します。ここでは青で示しますが、どの色相であっても彩度がゼロであれば 同じです。 色相(H) 明度(L) 彩度(S) 赤(R) 緑(G) 青(B) RGB 背景色 0 0 0 0 0 0 000000 ＊＊＊＊ 0 20 0 21 21 21 151515 ＊＊＊＊ 0 40 0 42 42 42 2A2A2A ＊＊＊＊ 0 60 0 63 63 63 3F3F3F ＊＊＊＊ 0 80 0 85 85 85 555555 ＊＊＊＊ 0 100 0 106 106 106 6A6A6A ＊＊＊＊ 0 120 0 127 127 127 7F7F7F ＊＊＊＊
30 0 140 0 148 148 148 949494 ＊＊＊＊ 0 160 0 170 170 170 AAAAAA ＊＊＊＊ 0 180 0 191 191 191 BFBFBF ＊＊＊＊ 0 200 0 212 212 212 D4D4D4 ＊＊＊＊ 0 220 0 233 233 233 E9E9E9 ＊＊＊＊ 0 240 0 255 255 255 FFFFFF ＊＊＊＊ 次は、青(H=0), 緑(H=80), 赤(H=160)について、それぞれ明度(L)と彩度(S)の変化を示 した図です。 青(H=0) →S↓L 0 40 80 120 160 200 240 0 000000 000000 000000 000000 000000 000000 000000 40 2A2A2A 232332 1D1D38 151540 0E0E47 07074E 000055 80 555555 474763 383872 2B2B80 1D1D8D 0E0E9C 0000AA 120 7F7F7F 6A6A95 5555AA 4040BF 2B2BD5 1515EA 0000FF 160 AAAAAA 9C9CB8 8D8DC7 8080D5 7272E2 6363F1 5555FF 200 D4D4D4 CDCDDC C7C7E2 BFBFEA B8B8F1 B1B1F8 AAAAFF 240 FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF 彩度がゼロ(S=0)のときは、明度に従って黒から白のグラデーションができます。彩度 を上げると、次第に色が鮮やかになりますが、明度が中位のときにもっとも明確な色 になります 緑(H=80) →S↓L 0 40 80 120 160 200 240 0 000000 000000 000000 000000 000000 000000 000000 40 2A2A2A 233223 1D381D 154015 0E470E 074E07 005500 80 555555 476347 387238 2B802B 1D8D1D 0E9C0E 00AA00 120 7F7F7F 6A956A 55AA55 40BF40 2BD52B 15EA15 00FF00 160 AAAAAA 9CB89C 8DC78D 80D580 72E272 63F163 55FF55 200 D4D4D4 CDDCCD C7E2C7 BFEABF B8F1B8 B1F8B1 AAFFAA 240 FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF
31 赤(H=160)
→S↓L 0 40 80 120 160 200 240
0 000000 000000 000000 000000 000000 000000 000000 40 2A2A2A 322323 381D1D 401515 470E0E 4E0707 550000 80 555555 634747 723838 802B2B 8D1D1D 9C0E0E AA0000 120 7F7F7F 956A6A AA5555 BF4040 D52B2B EA1515 FF0000 160 AAAAAA B89C9C C78D8D D58080 E27272 F16363 FF5555 200 D4D4D4 DCCDCD E2C7C7 EABFBF F1B8B8 F8B1B1 FFAAAA 240 FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF FFFFFF Word VBA のカラー定数 Word VBA で数字で色の値を指定しますが、その代わりに覚えやすいカラー定数を使 うことができます。そのとき、RGB 値は仕様で BGR の順番になるので注意してくだ さい。 カラー定数 値 BGR 色見本 wdBlack 1 000000 ＊＊＊＊ wdBlue 2 FF0000 ＊＊＊＊ wdTurquoise 3 FFFF00 ＊＊＊＊ wdBrightGreen 4 00FF00 ＊＊＊＊ wdPink 5 FF00FF ＊＊＊＊ wdRed 6 0000FF ＊＊＊＊ wdYellow 7 00FFFF ＊＊＊＊ wdWhite 8 FFFFFF ＊＊＊＊ wdDarkBlue 9 800000 ＊＊＊＊ wdTeal 10 808000 ＊＊＊＊ wdGreen 11 008000 ＊＊＊＊ wdViolet 12 800080 ＊＊＊＊ wdDarkRed 13 000080 ＊＊＊＊ wdDarkYellow 14 008080 ＊＊＊＊ wdGray50 15 808080 ＊＊＊＊ wdGray25 16 C0C0C0 ＊＊＊＊
32
1.3.2. プログラミングの練習
(0) TEXTOS-C-1 lbl 色相 [色相(H)] txt 色相 [0] 0-240 の範囲で色相を表示します。 spn 色相 [0] 色相の値を調節します。最大(Max)=12, 初期値(Value)=0 Option Explicit '変数を明示 Sub spn 色相_Change() txt 色相 = spn 色相 * 240 / 12 End Sub spn 色相の変化に応じて、txt 色相の値を代入します。spn 色相の最大(Max)が 12 であ り、txt 色相の最大(Max)が 240 なので、* 240 / 12 で調節します。つまり、spn 色相が 12 になったときに、txt 色相が 240 になります。 (1) TEXTOS-C-1 次のコントロールを追加します。33 txt 背景色 [0000FF] 16 進数を使って背景色を表示します。 txt 見本 スピンボタンの変化に応じて背景色と文字色を表示します。 lbl 明度 [明度(L)] txt 明度 [120] 0-240 の範囲で明度を表示します。 spn 明度 [6] 明度の値を調節します。最大(Max)=12, 初期値(Value)=6. lbl 彩度 [彩度(S)] txt 彩度 [240] 240: 0-240 の範囲で彩度を表示します。 spn 彩度 [12] 彩度の値を調節します。最大(Max)=12, 初期値(Value)=12. cmd 実行 [◎実行] Word 文書中の選択範囲の文字色、背景色、下線色を出力しま す。 標準モジュール
Declare Function FindWindow& Lib "user32.dll" Alias "FindWindowA" _ (ByVal C$, ByVal W$) 'ハンドル
Declare Function GetWindowLong& Lib "user32.dll" Alias "GetWindowLongA" _ (ByVal F&, ByVal I&) 'ボタン制御
Declare Function SetWindowLong& Lib "user32.dll" Alias "SetWindowLongA" _ (ByVal F&, ByVal I&, ByVal N&) 'メニューバー
Declare Function SetWindowPos& Lib "user32.dll" (ByVal Hw&, ByVal Ins&, _ ByVal X&, ByVal Y&, ByVal C&, ByVal D&, ByVal F&) 'フォーム表示状態 最小化ボタンを制御するライブラリーの関数を利用します。
Declare Function ColorHLSToRGB& Lib "SHLWAPI.DLL" _ (ByVal H%, ByVal L%, ByVal S%) 'RGB 関数
Declare Sub ColorRGBToHLS Lib "SHLWAPI.DLL" _ (ByVal clrRGB&, H%, L%, S%) 'HLS サブルーチン
色を指定する変数を変換用のライブラリーの関数を利用します。
Public lngRGB&, HexRGB$ '長整数型 RGB 値、16 進数 RGB 値 以下のプログラムで共通に使う変数です。
34
Public Function BGR$(W$) 'RGB$から 16 進数 BGR$に変換 BGR$ = "&H" & Right$(W$, 2) & Mid$(W$, 3, 2) & Left$(W$, 2) End Function 'RGB$から 16 進数 BGR$に変換する関数です。VBA では赤(R)・緑(G)・青(B)の順番で はなく、青(B)・緑(G)・青(R)の順番の 16 進数で色を指定する仕様なので、この変換 のための関数を作りました。 Sub Textos_C_色彩_0() Call UserForm_Show(fmTextos_C_色彩_0) End Sub Sub Textos_C_色彩_1() Call UserForm_Show(fmTextos_C_色彩_1) End Sub Sub Textos_C_色彩_2() Call UserForm_Show(fmTextos_C_色彩_2) End Sub Sub Textos_C_色彩_3() Call UserForm_Show(fmTextos_C_色彩_3) End Sub それぞれのユーザーフォームを引数として、次のサブルーチン UserForm_Show に渡し ます。 Sub UserForm_Show(M)
Dim F&, G&, S& '最小化ボタン用変数
M.Show vbModeless 'フォームをモードレスで表示
F& = FindWindow("ThunderDFrame", M.Caption) 'ハンドル G& = GetWindowLong(F&, -16) Or &H20000 'ウィンドウの情報 S& = SetWindowLong(F&, -16, G&) 'フォームボタン
S& = SetWindowPos(F&, -1, 150, 150, 0, 0, 1) '表示（ハンドル, 前面, x, y, 0, 0, 1) End Sub
35 渡されたフォームをモードレスで表示し、フォームに最小化ボタンを追加します。 Sub UserForm_Activate() 'フォーム表示 HexRGB$ = txt 背景色: Call 色見本 End Sub フォームを表示したとき、フォーム内の RGB 値(0000FF)を HEXRGB$に代入し、「色 見本」サブルーチンを実行します。 Sub spn 色相_Change() txt 色相 = spn 色相 * 240 / 12: Call RGB 変換: Call 色見本 End Sub spn 色相の変化に応じて、txt 色相の値を代入します。それぞれの最大(Max)が 12 と 240 なので、調節します。 Sub spn 明度_Change() txt 明度 = spn 明度 * 240 / 12: Call RGB 変換: Call 色見本 End Sub 明度についても同様です。 Sub spn 彩度_Change() txt 彩度 = spn 彩度 * 240 / 12: Call RGB 変換: Call 色見本 End Sub 彩度についても同様です。 Sub RGB 変換() 'txt 色相, txt 明度, txt 彩度 → HexRGB$ If Val(txt 彩度) = 0 Then '明度だけで RGB を表示
HexRGB$ = Right$("0" & Hex$(Int(txt 明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
LngRGB& = ColorHLSToRGB(txt 色相, txt 明度, txt 彩度) 'RGB 変換関数 HexRGB$ = Right$("00000" & Hex$(LngRGB&), 6)
End If End Sub
36 は、明度だけで HexRGB$の値を調節します。このとき R, G, B の最大(Max)255 を明度 の最大(Max)240 で割ります。この整数値を 2 桁の 16 進数に変換し、無彩色なので R=G=B とします。彩度がゼロでないときはライブラリーの RGB 変換関数を使って長 整数型の RGB 値を求め、それを 6 桁の 16 進数に変換します。 Sub 色見本() txt 背景色 = HexRGB$ txt 見本.BackColor = BGR$(txt 背景色) txt 見本.ForeColor = &HFFFFFF End Sub txt 背景色 RGB 値（6 桁の 16 進数）を代入し、txt 見本の背景色と文字色を出力します。
Private Sub cmd 実行_Click()
Selection.Font.Shading.BackgroundPatternColor = BGR$(txt 背景色) Selection.Font.Color = &HFFFFFF End Sub Word 文書内の選択範囲の背景色と文字色を出力します。 (2) TEXTOS-C-2 次のコントロールを追加します。 opt 背景色 [背景色] Word 文書中の選択範囲の文字列の背景色を指定します。 txt 背景色 [0000FF]16 進数を使って背景色を表示します。 opt 文字色 [文字色] Word 文書中の選択範囲の文字列の文字色を指定します。 txt 文字色 [FFFFFF] 16 進数を使って文字色を表示します。
37
cmd 純色 △純色：クリックすると明度を 120, 彩度を 240 にリセットします。 次のサブルーチンを追加します。
Sub opt 背景色_Click()
HexRGB$ = txt 背景色: Call HLS 変換 End Sub
opt 背景色がクリックしたとき、16 進数の txt 背景色を HexREG$に代入し、サブルー チン HLS 変換を呼びます。
Sub opt 文字色_Click()
HexRGB$ = txt 文字色: Call HLS 変換 End Sub
opt 背景色と同様です。
Private Sub cmd 純色_Click()
spn 明度 = 6: spn 彩度 = 12: Call 色見本 End Sub cmd 純色をクリックしたときに、spn 明度 を中位の 6 に、spn 彩度を最大(Max)の 12 にリセットして、サブルーチン色見本を呼び出します。 Sub HLS 変換() 'HexRGB$ → spnt 色相, spn 明度, spn 彩度 Dim H%, L%, S%
Call ColorRGBToHLS("&H" & HexRGB$, H%, L%, S%) 'HLS 変換サブルーチン spn 色相 = IIf(L% = 0 Or L% = 240 Or S% = 0, 0, H% * 12 / 240) spn 明度 = L% * 12 / 240 spn 彩度 = S% * 12 / 240 End Sub ライブラリーの HLS 変換サブルーチンに RGB 値とそれぞれの変数名を渡すと、それ ぞれの変数に値が返される。それらをスピンボタンに代入します（テキストボックス に代入することも可能ですが、スピンボックスに代入すればテキストボックスと値が 連動します。）。スピンボタンの最大(Max)は 12 であり、それと連動するテキストボ ックスの最大(Max)は 240 なので 12/240 で調節します。無彩色の場合は色相をゼロと します。
38
Sub RGB 変換() 'txt 色相, txt 明度, txt 彩度 → HexRGB$ If Val(txt 彩度) = 0 Then '明度だけで RGB を表示
HexRGB$ = Right$("0" & Hex$(Int(txt 明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
LngRGB& = ColorHLSToRGB(txt 色相, txt 明度, txt 彩度) 'RGB 変換関数 HexRGB$ = Right$("00000" & Hex$(LngRGB&), 6)
End If End Sub txt 色相、txt 明度、txt 彩度の値から RGB 値を得るためのサブルーチンです。彩度が ゼロのときは、明度だけで RGB の値を表示します。赤、緑、青の値は同じで、明度 の大きさに応じて 0 ~ 255 の範囲で増減させます。彩度がゼロでなければ、色相、明 度、彩度の値を引数として、RGB 変換関数が返す値を 16 進数に変え、該当するテキ ストボックスに出力します。 (3) TEXTOS-C-3 次のコントロールを追加します。 lbl 赤 赤(R) txt 赤 0-255 の範囲で赤の値を表示します。 spn 赤 赤の値を調節します。 lbl 緑 緑(G) txt 緑 0-255 の範囲で緑の値を表示します。 spn 緑 緑の値を調節します。
39 lbl 青 青(B) txt 青 0-255 の範囲で青の値を表示します。 spn 青 青の値を調節します。 次のサブルーチンに一部を追加します。最後の txt 赤、txt 緑、txt 青の値は、色相、明 度、彩度の値に連動します。 Sub RGB 変換() 'txt 色相, txt 明度, txt 彩度 → txt 赤、txt 緑、txt 青 If Val(txt 彩度) = 0 Then '明度だけで RGB を表示
HexRGB$ = Right$("0" & Hex$(Int(txt 明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
lngRGB& = ColorHLSToRGB(txt 色相, txt 明度, txt 彩度) 'RGB 変換関数 HexRGB$ = Right$("00000" & Hex$(lngRGB&), 6)
End If txt 赤 = Mid$(HexRGB$, 1, 2) txt 緑 = Mid$(HexRGB$, 3, 2) txt 青 = Mid$(HexRGB$, 5, 2) End Sub 次のサブルーチンを追加します。 Sub spn 赤_Change()
txt 赤 = Right$("0" & Hex$(Int(spn 赤 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub
spn 赤が変化したときに、txt 赤 2 桁の 16 進数を代入し、6 桁の 16 進数で RGB 値を計 算し、HLS 変換と色見本のサブルーチンを呼び出します。
Sub spn 緑_Change()
txt 緑 = Right$("0" & Hex$(Int(spn 緑 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub
40 spn 赤と同様です。
Sub spn 青_Change()
txt 青 = Right$("0" & Hex$(Int(spn 青 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub spn 赤と同様です。 TEXTOS-2「色彩」全体のコード Sub ■色彩() '*********************************************** If chk 文字色 Then Selection.Font.Color = BGR$(txt 文字色値) If chk 下線色 Then Selection.Font.Underline = wdUnderlineWavy
If chk 下線色 Then Selection.Font.UnderlineColor = BGR$(txt 下線色値)
If chk 蛍 光 色 Then Selection.Range.HighlightColorIndex = Options.DefaultHighlightColorIndex
Selection.Font.Bold = chk 太字 End Sub
Sub opt 文字色_Click()
HexRGB$ = txt 文字色値: Call HLS 変換: Call RGB 変換 End Sub
Sub opt 下線色_Click()
HexRGB$ = txt 下線色値: Call HLS 変換: Call RGB 変換 End Sub Sub spn 色相_Change() txt 色相 = spn 色相 * 240 / 12: Call RGB 変換: Call 色見本 End Sub Sub spn 明度_Change() txt 明度 = spn 明度 * 240 / 12: Call RGB 変換: Call 色見本 End Sub
41 Sub spn 彩度_Change()
txt 彩度 = spn 彩度 * 240 / 12: Call RGB 変換: Call 色見本 End Sub
Sub spn 赤_Change()
txt 赤 = Right$("0" & Hex$(Int(spn 赤 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub
Sub spn 緑_Change()
txt 緑 = Right$("0" & Hex$(Int(spn 緑 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub
Sub spn 青_Change()
txt 青 = Right$("0" & Hex$(Int(spn 青 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub
Sub cmd 純色_Click()
spn 明度 = 6: spn 彩度 = 12: Call 色見本 End Sub
Private Sub cmd 黒_Click()
spn 明度 = 0: spn 彩度 = 0: Call 色見本 End Sub
Private Sub cmd 白_Click()
spn 明度 = 12: spn 彩度 = 0: Call 色見本 End Sub
Sub HLS 変換() 'HexRGB$ → spnt 色相, spn 明度, spn 彩度 Dim H%, L%, S%
42
Call ColorRGBToHLS("&H" & HexRGB$, H%, L%, S%) 'HLS 変換サブルーチン spn 色相 = IIf(L% = 0 Or L% = 240 Or S% = 0, 0, H% * 12 / 240) spn 明度 = L% * 12 / 240 spn 彩度 = S% * 12 / 240 End Sub Sub RGB 変換() 'txt 色相, txt 明度, txt 彩度 → txt 赤、txt 緑、txt 青 If Val(txt 彩度) = 0 Then '明度だけで RGB を表示
HexRGB$ = Right$("0" & Hex$(Int(txt 明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
lngRGB& = ColorHLSToRGB(txt 色相, txt 明度, txt 彩度) 'RGB 変換関数 HexRGB$ = Right$("00000" & Hex$(lngRGB&), 6)
End If
txt 赤 = Mid$(HexRGB$, 1, 2) txt 緑 = Mid$(HexRGB$, 3, 2) txt 青 = Mid$(HexRGB$, 5, 2) End Sub
Private Sub cbo 蛍光色_Change() Call 色見本
End Sub
Sub 色見本()
If opt 文字色 Then txt 文字色値 = HexRGB$ If opt 下線色 Then txt 下線色値 = HexRGB$
txt 文字色.ForeColor = BGR$(txt 文字色値) txt 下線色.BackColor = BGR$(txt 下線色値)
txt 文字色.BackColor = "&H" & 蛍光色配列$(cbo 蛍光色.ListIndex) Options.DefaultHighlightColorIndex = cbo 蛍光色.ListIndex
43 txt 文字色.Font.Bold = chk 太字
End Sub
Function BGR$(W$) 'RGB$から 16 進数 BGR$に変換
BGR$ = "&H" & Right$(W$, 2) & Mid$(W$, 3, 2) & Left$(W$, 2) End Function
1.3.3. フォームとコード
opt 文字色 [文字色] Word 文書中の選択範囲の文字列の文字色を指定します。 txt 文字色 [FFFFFF] 16 進数を使って文字色を表示します。 opt 下線色 [下線色] Word 文書中の選択範囲の文字列の下線色を指定します。 txt 下線色 [0000FF]16 進数を使って下線色を表示します。 cmd 純色 色相、明度、彩度、赤、緑、青の値を純色にリセットします。 cmd 黒 色相、明度、彩度、赤、緑、青の値を黒にリセットします。 cmd 白 色相、明度、彩度、赤、緑、青の値を白にリセットします。 lbl 色相 [色相(H)] txt 色相 [0] 0-240 の範囲で色相を表示します。 spn 色相 [0] 色相の値を調節します。最大(Max)=12, 初期値(Value)=0 lbl 明度 [明度(L)] txt 明度 [120] 0-240 の範囲で明度を表示します。44 spn 明度 [6] 明度の値を調節します。最大(Max)=12, 初期値(Value)=6. lbl 彩度 [彩度(S)] txt 彩度 [240] 240: 0-240 の範囲で彩度を表示します。 spn 彩度 [12] 彩度の値を調節します。最大(Max)=12, 初期値(Value)=12. lbl 赤 赤(R) txt 赤 0-255 の範囲で赤の値を表示します。 spn 赤 赤の値を調節します。 lbl 緑 緑(G) txt 緑 0-255 の範囲で緑の値を表示します。 spn 緑 緑の値を調節します。 lbl 青 青(B) txt 青 0-255 の範囲で青の値を表示します。 spn 青 青の値を調節します。 マルチページの外に次のオブジェクトがあります。 txt 文字色 色相、明度、彩度、赤、緑、青の値にしたがって文字色の見本を示しま す。 txt 下線色 色相、明度、彩度、赤、緑、青の値にしたがって文字色の見本を示しま す。 cmd 実行 プログラムを実行します。 cmd 消去 出力用の Word ファイルや Excel ファイルをを消去します。 cmd 復元 復元を 1 回実行します。[Ctrl]+Z と同じです。 Sub cmd 実行_Click() Call 実行準備
Select Case ページ.Value 'ページでケースを選択 Case 1: Call ■色彩
Case 2: Call ■単語リスト Case 3: Call ■検索置換 Case 4: Call ■分析 End Select
cmd 実行.Caption = "●実行:" & Int(Timer - 開始時間) & "秒" End Sub
45 Sub 実行準備()
開始時間 = Timer: cmd 実行.Caption = "○実行中": DoEvents
If Len(Selection) < 2 Then
If MsgBox("全範囲を選択しますか？", vbYesNoCancel, "範囲選択") = vbYes Then Selection.WholeStory '全範囲選択 Else Exit Sub '実行終了 End If End If 出力文字列$ = "": 出力文字数& = 0 '初期化 End Sub Sub cmd 消去_Click()
On Error GoTo Errores 'エラー処理
If (ページ.Value = 2 And chk 新文書) Or (ページ.Value = 3 And chk 新文書 2) Then '単語リストまたは検索置換であれば… ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges '新文書をセーブしない で閉じる End If If ページ.Value = 4 Then '分析であれば…
obj エクセル.ActiveWorkbook.Close SaveChanges:=False 'ブックをセーブしないで 閉じる
End If Exit Sub Errores:
Call フォーム後面: MsgBox "●エラー：" & Error(Err): Call フォーム前面 End Sub
Sub cmd 復元_Click()
ActiveDocument.Undo '元に戻す End Sub
46
Sub UserForm_QueryClose(Cancel%, CloseMode%) '×終了ボタン Set obj 照合配列 = Nothing
Set obj 連想配列 = Nothing Set obj 正規表現 = Nothing Set obj エクセル = Nothing
End '終了 End Sub
Sub ■色彩() ****************************************************** If chk 文字色 Then Selection.Font.Color = BGR$(txt 文字色値)
If chk 下線色 Then Selection.Font.Underline = wdUnderlineWavy
If chk 下線色 Then Selection.Font.UnderlineColor = BGR$(txt 下線色値)
If chk 蛍 光 色 Then Selection.Range.HighlightColorIndex = Options.DefaultHighlightColorIndex
Selection.Font.Bold = chk 太字 End Sub
Sub opt 文字色_Click()
HexRGB$ = txt 文字色値: Call HLS 変換: Call RGB 変換 End Sub
Sub opt 下線色_Click()
HexRGB$ = txt 下線色値: Call HLS 変換: Call RGB 変換 End Sub Sub spn 色相_Change() txt 色相 = spn 色相 * 240 / 12: Call RGB 変換: Call 色見本 End Sub Sub spn 明度_Change() txt 明度 = spn 明度 * 240 / 12: Call RGB 変換: Call 色見本 End Sub Sub spn 彩度_Change() txt 彩度 = spn 彩度 * 240 / 12: Call RGB 変換: Call 色見本
47 End Sub
Sub spn 赤_Change()
txt 赤 = Right$("0" & Hex$(Int(spn 赤 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub
Sub spn 緑_Change()
txt 緑 = Right$("0" & Hex$(Int(spn 緑 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub
Sub spn 青_Change()
txt 青 = Right$("0" & Hex$(Int(spn 青 * 255 / 17)), 2) HexRGB$ = txt 赤 & txt 緑 & txt 青
Call HLS 変換: Call 色見本 End Sub Sub cmd 純色_Click() spn 明度 = 6: spn 彩度 = 12: Call 色見本 End Sub Sub cmd 黒_Click() spn 明度 = 0: spn 彩度 = 0: Call 色見本 End Sub Sub cmd 白_Click() spn 明度 = 12: spn 彩度 = 0: Call 色見本 End Sub Sub HLS 変換() 'HexRGB$ → spnt 色相, spn 明度, spn 彩度 Dim H%, L%, S%
48 spn 色相 = IIf(L% = 0 Or L% = 240 Or S% = 0, 0, H% * 12 / 240) spn 明度 = L% * 12 / 240 spn 彩度 = S% * 12 / 240 End Sub Sub RGB 変換() 'txt 色相, txt 明度, txt 彩度 → txt 赤、txt 緑、txt 青 If Val(txt 彩度) = 0 Then '明度だけで RGB を表示
HexRGB$ = Right$("0" & Hex$(Int(txt 明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
lngRGB& = ColorHLSToRGB(txt 色相, txt 明度, txt 彩度) 'RGB 変換関数 HexRGB$ = Right$("00000" & Hex$(lngRGB&), 6)
End If
txt 赤 = Mid$(HexRGB$, 1, 2) txt 緑 = Mid$(HexRGB$, 3, 2) txt 青 = Mid$(HexRGB$, 5, 2) End Sub
Sub cbo 蛍光色_Change() Call 色見本
End Sub
Sub 色見本()
If opt 文字色 Then txt 文字色値 = HexRGB$ If opt 下線色 Then txt 下線色値 = HexRGB$
txt 文字色.ForeColor = BGR$(txt 文字色値) txt 下線色.BackColor = BGR$(txt 下線色値)
txt 文字色.BackColor = "&H" & 蛍光色配列$(cbo 蛍光色.ListIndex) Options.DefaultHighlightColorIndex = cbo 蛍光色.ListIndex
txt 文字色.Font.Bold = chk 太字 End Sub
49
Function BGR$(W$) 'RGB$から 16 進数 BGR$に変換
BGR$ = "&H" & Right$(W$, 2) & Mid$(W$, 3, 2) & Left$(W$, 2) End Function
50
1.4. 単語リスト
Word のテキスト内にある単語を抽出し、異なり語のリストを作成するプログラムで す。また Word のテキスト内の単語（または単語リスト）を、先に作成した単語リス トと照合して、その異同を確かめます。 opt 単語リスト テキストまたはリストにある単語（異なり語）のリストを作 成します。 cmd 照合リスト 次の同語検索と異語検索に使う照合文書を入力します。 opt 照合同語検索 現文書の単語が照合リストに存在すれば、それを青色でマー クします。あらかじめ、文書の中でよく使われる語のリスト を作成すれば、繰り返された語をチェックすることができま す。また、注目すべき語をマークすることができます。 opt 照合異語検索 現文書の単語が照合する単語リストに存在しなければ、それ を緑色でマークします。スペルチェックに利用します。 opt 照合同語リスト 照合リストに存在する現文書の単語リストを出力します。 opt 照合異語リスト 照合リストに存在しない現文書の単語リストを出力します。 chk 新文書 新文書に出力します。 cmd 実行 選択したオプションを実行します。51 データ例(1) 単語リスト：テキストの異なる単語リストを作成します。 単語リスト 単語 リスト ： テキスト の 異なる を 作成 します 。 照合同語検索 上の単語リストの出力を単語.docx として保存し、これを照合リストとします。「照合 リスト」ボタンをクリックして、この単語.docx を選択してください。これは変更しな い限り一度だけです。 データ例(2) 異なる単語の頻度を計算します。 照合異語検索 異なる単語の頻度を計算します。 照合同語リスト 異なる 単語 の を します 。 照合異語リスト 頻度
52 計算 コード Sub ■単語リスト() '******************************************* If chk 新文書 Then Call 新文書 obj 連想配列.RemoveAll '連想配列のキーとアイテムを削除 If opt 単語リスト Then 単語リスト
If opt 照合同語検索 Or opt 照合異語検索 Then Call 同語異語検索 If opt 照合同語リスト Or opt 照合異語リスト Then Call 同語異語リスト End Sub 同語検索と異語検索の手順はほとんど同じですが、異なる部分（連想配列との照合の 仕方）についてはサブルーチンの中で区別します。同語リストと異語リストについて も同様です。 Sub 新文書() Selection.Copy '選択範囲コピー Documents.Add '新文書追加 Selection.Paste 'ペースト Selection.WholeStory '全範囲選択 End Sub 選択範囲を新文書にコピー&ペーストし、全範囲を選択します。 Sub cmd 照合リスト_Click()
Dim F&, S& '最小化ボタン用変数
F& = FindWindow("ThunderDFrame", fmTextos_2.Caption) 'ハンドル S& = SetWindowPos(F&, 1, 150, 150, 0, 0, &H1) 'フォームを後面に
With Dialogs(wdDialogFileOpen) 'ダイアログボックス .Name = "*.docx": .Display 'ダイアログボックス表示
If InStr(.Name, "*") Or .Name = "" Then Exit Sub '文書名なし→終了 Documents.Open FileName:=.Name '選択した文書を開く
53 End With
If MsgBox("OK、またはキャンセル？", vbOKCancel) = vbCancel Then '確認 ActiveDocument.Close: Exit Sub '現文書を閉じる
End If 単語配列$ = Split(ActiveDocument.Range.Text, vbCr) '改行でスプリット txt 照合リスト = ActiveDocument.Range.Text ActiveDocument.Close '現文書を閉じる obj 照合配列.RemoveAll '連想配列のキーとアイテムを削除 For Each 単語 v In 単語配列$ '単語リストファイル 単語 v = 正規表現置換$(単語 v, 拡張正規表現$("¥L"), "", False) '単語文字列にトリム obj 照合配列(単語 v) = "" '存在の標識 Next
S& = SetWindowPos(F&, -1, 150, 150, 0, 0, &H1) 'フォームを前面に End Sub
ダイアログボックスで改行で区切られた単語リストの文書を開き、文書の内容を開業 でスプリットして配列を作成し、その配列のキーを連想配列のキーとしてアイテムに 空白を代入します。
54 Sub 単語リスト()
obj 連想配列.RemoveAll '連想配列のキーとアイテムを削除
For Each 単語 v In Selection.Words '選択範囲の語について
単語 v = 正規表現置換$(単語 v, 拡張正規表現$("¥L"), "", False) '単語文字列にトリム
If 単語 v <> "" And Not obj 連想配列.Exists(単語 v) Then '連想配列にキーがなければ… obj 連想配列(単語 v) = "" '存在の標識 追加文字列$ = 単語 v & vbCr '単語＆改行 Call 高速文字列作成 End If Next Call 高速文字列出力 End Sub For … Next で選択範囲の語を連想配列に格納します。アイテムは何でもかまいません が、ここではキーによって格納の有無が判断されます。格納されていない語は新語（異 語）となるので、これに改行コードを加えて高速文字列作成を行います。 Sub 同語異語検索()
For Each 単語 v In Selection.Range.Words '選択範囲の語について
作業文字列$ = 正規表現置換$(単語 v, 拡張正規表現$("¥L"), "", False) '単語文字列にトリム
If 作業文字列$ <> "" _
And obj 照合配列.Exists(作業文字列$) = opt 照合同語検索 Then If chk 文字色 Then 単語 v.Font.Color = BGR$(txt 文字色値) If chk 下線色 Then 単語 v.Font.Underline = wdUnderlineWavy
If chk 下線色 Then 単語 v.Font.UnderlineColor = BGR$(txt 下線色値) If chk 蛍光色 _
Then 単語 v.HighlightColorIndex = Options.DefaultHighlightColorIndex 単語 v.Font.Bold = chk 太字
End If Next
55 End Sub 選択範囲のそれぞれの語について特殊文字を除去し（トリム）、その語の連想配列内 の有無と同語・異語検索のオプションが一致すれば、文字色、下線色、蛍光色、太字 を加えます。 Sub 同語異語リスト()
For Each 単語 v In Selection.Range.Words '選択範囲の語について 単語 v = 正規表現置換$(単語 v, 拡張正規表現$("¥L"), "", False) '単語文字列にトリム
If 単語 v <> "" And obj 照合配列.Exists(単語 v) = opt 照合同語リスト _ And Not obj 連想配列.Exists(単語 v) Then
追加文字列$ = 単語 v & vbCr '単語と改行の連続 Call 高速文字列作成 obj 連想配列(単語 v) = "" '存在の標識 End If Next Call 高速文字列出力 End Sub 選択範囲のそれぞれの語について特殊文字を除去し（トリム）、その語の連想配列内 の有無と同語・異語検索のオプションが一致し、、出力文字列に未だ存在しない語を 高速文字列作成によって出力文字列に追加し、すべての単語の検索を修了したら、文 字列を出力します。 Sub 高速文字列作成()
If 出力文字数& + Len(追加文字列$) > Len(出力文字列$) Then 出力文字列$ = 出力文字列$ & Space(99999) '領域超過→領域拡張 End If
Mid$(出力文字列$, 出力文字数& + 1) = 追加文字列$ '追加文字列挿入 出力文字数& = 出力文字数& + Len(追加文字列$) '全文字列の長さ End Sub
文字列の作成を高速化するために次の工夫をします。出力文字数& + Len(追加文字列 $)が出力文字列$の長さを超えたとき、つまり、追加文字列が Mid 関数で挿入できなく
56 なったときに、出力文字列$ に大きなスペースの領域 Space(99999)を追加して拡張し ます。そのようにして適宜拡張した出力文字列の中に追加文字列を Mid 関数で挿入し ていきます。このサブルーチンの中では出力文字列$だけでは、後部に不要なスペース があるので、その他に出力文字数&の情報も後で必要になります。これは現在の出力 文字数&に追加文字列の長さを加えた数になります。このサブルーチンは呼び出され る度に次のような出力文字列と出力文字数を作ります。 1: 出力文字列-1＝追加文字列＋スペース 出力文字数-1＝追加文字数 2: 出力文字列-2＝出力文字列-1＋追加文字列＋スペース 出力文字数-2＝出力文字数-1＋追加文字数 3: 出力文字列-3＝出力文字列-1＋出力文字列-2＋追加文字列＋スペース 出力文字数-3＝出力文字数-1＋出力文字数-2＋追加文字数 (…) 文字列の作成を高速化するために次の工夫をします。出力文字数 & + Len(追加文字列 $)が出力文字列$の長さを超えたとき、つまり、追加文字列が Mid 関数で挿入できなく なったときに、出力文字列$ に大きなスペースの領域 Space(99999)を追加して拡張し ます。そのようにして適宜拡張した出力文字列の中に追加文字列を Mid 関数で挿入し ていきます。このサブルーチンの中では出力文字列$だけでは、後部に不要なスペース があるので、その他に出力文字数&の情報も後で必要になります。これは現在の出力 文字数&に追加文字列の長さを加えた数になります。このサブルーチンは呼び出され る度に次のような出力文字列と出力文字数を作ります。 1: 出力文字列-1＝追加文字列＋スペース 出力文字数-1＝追加文字数 2: 出力文字列-2＝出力文字列-1＋追加文字列＋スペース 出力文字数-2＝出力文字数-1＋追加文字数 3:
57 出力文字列-3＝出力文字列-1＋出力文字列-2＋追加文字列＋スペース 出力文字数-3＝出力文字数-1＋出力文字数-2＋追加文字数 (…) 単に出力文字列を追加文字列をつなげてていけば簡単な操作になるのですが、そうす ると文字列追加の度にメモリーの確保が必要になるので時間がかかります。それより も、追加文字列が出力文字列の余裕分（スペース）を超えたときにだけ、追加したほ うが時間が節約できるのです。そして、そのスペースをかなり大きくとってあるので (99999)、If 文の中の処理が行われることはあまりありません。それでは、最初からた くさんスペースをとっておけばよい、とも考えられますが、出力文字列の大きさが最 終的にどのくらいになるのかわからないので、適宜（少数回）増加させる、という方 法をとります。 Sub 高速文字列出力()
Selection = Left$(出力文字列$, 出力文字数&) '文字列の該当部分を出力 Selection.ClearFormatting '書式クリア
End Sub
選択範囲に文字列の該当部分、つまり出力文字列の中の出力文字数分だけを代入しま す。出力文字列をそのまま代入すると余分なスペースも出力されてしまいます。
58
