' ****************************************************************************
' *                                                                          *
' *    GothicBlue   ＭＳゴシックの文字列を青色にするマクロ  Version 1.00     *
' *                                                                          *
' *           マクロ名: GothicBlue100      公開日: 1995/10/21                *
' *                                                                          *
' *                   Copyright (C) 1995 Fumio Kawamata                      *
' *                                                                          *
' ****************************************************************************
'
' ########## このマクロについて ##########
' (1)このマクロは、Microsoft Word Version6.0の文書内の、ＭＳゴシックフォント
'    の文字列を青色に設定するマクロです。
'    画面上では、ＭＳ明朝とＭＳゴシックの違いがはっきりしないために作成した
'    ものです。
' (2)このマクロはフリーソフトウェアです。著作権表示を改変しない限り
'    再利用、再配布などは勝手にやって下さい。（改造したものの再配布も可）。
' (3)ユーザーサポートは必要ないと思いますが、やるとすれば、NIFTY-Serve
'    SMSAPP（マイクロソフトステーション）の WORD会議室で行います。
'    個人メールでの連絡はご遠慮下さい。
' (4)表内ではSelectCurFont（同一フォント範囲の選択）が正常に機能しないために
'    １文字毎に処理しています。
'
' ########## このマクロの登録の仕方 ##########
' 他に方法があるかもしれませんが、私の方法は以下のとおりです。
' (1)まず、このマクロをクリップボードにコピーしておきます。
' (2)Microsoft Word の[ツール(O)]-[マクロ(M)...]メニューを選択すると、
'    [マクロ]ダイヤログボックスがオープンします。
' (3)[マクロ名(M)]テキストボックスにマクロ名を入力します。
'    （マクロ名は自由なのですが、一部改造したものを共存させるために
'      ヴァージョンがわかるような名前にしておくといいでしょう。）
' (4)[マクロ作成(E)]ボタンを押すと、マクロ編集用のエディタがオープンします。
'      Sub MAIN
'      
'      End Sub
'   というテキストが表示されますが、これをキーボードを使って削除します。
' (5)つづいて、クリップボードにコピーしておいたこのマクロを貼り付けます。
' (6)[ファイル(F)]-[テンプレートの保存(S)]メニューを選択します。
'
' ########## 使い方 ##########
' (1)まず、変換したい文書をオープンします。
' (2)このマクロによって設定されたフォントの色は、元のままの状態には戻すことが
'    できませんので、必要ならバックアップコピーを作成して下さい。
' (3)文書は、アクティブな状態（タイトルバーが青い状態）にしておきます。
' (4)[ツール(O)]-[マクロ(M)...]メニューを選択します。
'    [マクロ]ダイヤログボックスがオープンします。
' (5)[マクロ名(M)]リストボックスから、登録したマクロ名を選択し、
'    <実行(R)>ボタンをクリックします。
' (6)メニューダイヤログがポップアップしますので、いずれかを処理を選択して、
'    <OK>ボタンを押します。
' (7)処理中は[ESC]キーを押せばその時点で処理を終了します。
'    再実行すると最初からやり直します。
'
'
'
Dim Shared ProgName$	' プログラム名
'
'
'
Sub MAIN
	' メインルーチン
	'
	Dim MyMenuDialog As UserDialog
	ProgName$ = "Gothic Blue  Version 1.00"
	Copyright$ = Chr$(13) + Chr$(13) + Chr$(9) + "            " + ProgName$ + Chr$(13) + "        Copyright (C) 1995 Fumio Kawamata"
	'
' ダイヤログボックスの定義
'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
Begin Dialog UserDialog 330, 140, ProgName$, .MenuDialog
	GroupBox 17, 13, 291, 76, "処理区分", .DocType
	OptionGroup  .OptionGroup1
		OptionButton 32, 29, 250, 18, "文書全体（表があっても可）", .OptionButton1
		OptionButton 33, 47, 249, 18, "文書全体（表があっては不可）", .OptionButton2
		OptionButton 33, 67, 250, 18, "選択範囲（表があっても可）", .OptionButton3
	OKButton 17, 110, 88, 21, .OkButton
	CancelButton 122, 110, 88, 21, .CancelButton
	PushButton 225, 109, 88, 21, "About", .About
End Dialog
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	'
	Button = 1
	While Button = 1
		Button = Dialog(MyMenuDialog)
		''MsgBox "Button=" + Str$(Button), 48
		If Button = 1 Then
			MsgBox "ＭＳゴシックフォントの文字列を青色に設定します。処理結果のアンドウは出来ませんので必要ならバックアップを作成して下さい。" + Copyright$, ProgName$, 64
		EndIf
	Wend
	If Button = - 1 Then
		Select Case MyMenuDialog.OptionGroup1
			Case 0
				Call SetColorOneByOne
			Case 1
				Call SetColor
			Case 2
				Call SetColorInSelRange
		End Select
		MsgBox "処理を終了しました", ProgName$, 64
	Else
		MsgBox "キャンセルしました", ProgName$, 64
	End If
End Sub
'
Function MenuDialog(identifier$, action, suppvalue)
End Function
'
'
'
Sub SetColorOneByOne
	' １文字づつ文書全体を処理
	'
	SelType 1				' 選択解除
	StartOfDocument			' カーソルを文書の先頭に移動
	EndOfDoc = 0
	While EndOfDoc = 0
		SelType 1' 選択解除
		CharRight(1, 1)' カーソルを１文字進める
		SelectedText$ = GetText$(GetSelStartPos(), GetSelEndPos())
		If SelectedText$ = Chr$(13) Then
			SelType 1' 選択解除
			If CharRight(1, 0) = 0 Then' カーソルを進めることができない場合
				EndOfDoc = - 1
			End If
		Else
			If InStr(SelectedText$, Chr$(13)) = 0 Then
				If Font$() = "ＭＳ ゴシック" Then CharColor(2)' 青色にセット
			End If
			If CharRight(1, 0) = 0 Then' カーソルを進めることができない場合
				EndOfDoc = - 1
			EndIf
		End If
	Wend
	StartOfDocument' カーソルを文書の先頭に移動
End Sub
'
'
'
Sub SetColor
	' SelectCurFontを使った文書全体の処理
	'
	SelType 1			' 選択解除
	StartOfDocument		' カーソルを文書の先頭に移動
	EndOfDoc = 0
	'
	While EndOfDoc = 0
		SelType 1' 選択解除
			SelectCurFont' 同一フォント範囲を選択
			SelectedText$ = GetText$(GetSelStartPos(), GetSelEndPos())
			If SelectedText$ = Chr$(13) Then' 改行記号
				SelType 1' 選択解除
				If CharRight(1, 0) = 0 Then' カーソルを進めることができない場合
					EndOfDoc = - 1
				EndIf
			Else
				If Font$() = "ＭＳ ゴシック" Then CharColor(2)
				If CharRight(1, 0) = 0 Then' カーソルを進めることができない場合
				EndOfDoc = - 1
			EndIf
		End If			
	Wend
	StartOfDocument' カーソルを文書の先頭に移動
End Sub
'
'
'
Sub SetColorInSelRange
	' 選択範囲の処理
	'
	Dim I				' ループ変数
	Dim Range1			' 選択範囲の開始位置
	Dim Range2			' 選択範囲の終了位置
	Dim SelectedText$	' 選択文字列
	'
	Range1 = GetSelStartPos()
	Range2 = GetSelEndPos()
	If Range1 = Range2 Then
		MsgBox "文字列が選択されていません", ProgName$, 48
	Else
		For I = Range1 To (Range2 - 1)
			MsgBox "Checking " + Str$(I) + "/" + Str$(Range2 - 1), - 1
			On Error Resume Next' エラー時はエラーを無視して次の行へ
			SetSelRange I, I + 1' 文字列選択
			On Error Goto 0' エラー無視の解除
			If Font$() = "ＭＳ ゴシック" Then CharColor(2)
			If I < (Range2 - 1) Then
				On Error Resume Next' エラー時はエラーを無視して次の行へ
				CharRight 1, 0' カーソルを１文字進める
				On Error Goto 0' エラー無視の解除
			EndIf
		Next I
		SelType 1' 選択解除
		CharRight 1, 0' カーソルを１文字進める
	EndIf
End Sub
'