フォームとコード

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

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%

Call ColorRGBToHLS("&H" & HexRGB$, H%, L%, S%) 'HLS 変換サブルーチン

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