Sub myKatakanaScaling()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem カタカナ文字幅倍率一括設定処理
  Rem 記録者：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能...
  Rem   カタカナを検索し、文字幅を指定した倍率（％）に設定する。
  Rem 注記：「myKatakanaScaling」を起動して使用｡
  Rem 履歴...
  Rem   第1版：2002/12/14：作成。
  Rem   第2版：2005/01/15：全面改訂。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myKatakana As String
  Dim myStartMarker As Word.Range
  Dim myValue As Integer
  Dim myScaling As Integer
  '
  myKatakana = "[ァ-" & ChrW(Val("&h30FA")) & "]"  '  &h30FA : 「ヲ゛」
  '
  Assistant.Visible = True
  '
  With Assistant.NewBalloon
    .Animation = msoAnimationWritingNotingSomething
    .BalloonType = msoBalloonTypeButtons
    .Icon = msoIconAlertQuery
    .Button = msoButtonSetCancel
    .Heading = "カタカナ" & vbCr & "文字幅倍率" & vbCr & "一括設定処理"
    .Text = "倍率を選択して下さい。"
    .Labels(1).Text = "100%"
    .Labels(2).Text = " 80%"
    .Labels(3).Text = " 66%"
    .Labels(4).Text = " 50%"
    .Labels(5).Text = " 33%"
    myValue = .Show
  End With
  '
  Select Case myValue
    Case 1
      myScaling = 100
    Case 2
      myScaling = 80
    Case 3
      myScaling = 66
    Case 4
      myScaling = 50
    Case 5
      myScaling = 33
    Case -2 ' [キャンセル]ボタン時
      Assistant.NewBalloon.Close
      Assistant.Visible = False
      Exit Sub
  End Select
  '
  Rem 検索開始点を取得する。
  Set myStartMarker = Selection.Range
  Selection.Collapse wdCollapseStart
  '
  Rem ワイルドカードでカタカナの文字列検索を指定する。
  With Selection.Find
    .ClearFormatting
    .Text = myKatakana & "{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
  End With
  '
  Do While Selection.Find.Execute
    With Selection.Range
      Selection.Font.Scaling = myScaling
    End With
    Selection.Collapse wdCollapseEnd
  Loop
  '
  Rem 検索開始点に戻る。
  myStartMarker.Select
  Selection.Collapse wdCollapseStart
  '
  Rem カタカナの後に続く中点・長音符・連字符・旧表記繰り返し記号を検索する。
  myKatakana = myKatakana & "{1,}" & "[・ー‐"
  myKatakana = myKatakana & ChrW(Val("&h30FD")) & ChrW(Val("&h30FE"))
  myKatakana = myKatakana & "]{1,}"
  '
  Rem ワイルドカードで文字列検索を指定する。
  With Selection.Find
    .ClearFormatting
    .Text = myKatakana & "{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
  End With
  '
  Do While Selection.Find.Execute
    With Selection.Range
      Selection.Font.Scaling = myScaling
    End With
    Selection.Collapse wdCollapseEnd
  Loop
  '
  Rem 処理終了の表示。
  With Assistant.NewBalloon
    .Animation = msoAnimationCharacterSuccessMajor
    .BalloonType = msoBalloonTypeButtons
    .Icon = msoIconAlertQuery
    .Button = msoButtonSetOK
    .Heading = "カタカナ" & vbCr & "文字幅倍率" & vbCr & "一括設定処理"
    .Text = "処理が終了しました。"
    .Show
  End With
  '
  myStartMarker.Select
  '
  Assistant.NewBalloon.Close
  Assistant.Visible = False
End Sub ' myKatakanaScaling *----*----*    *----*----*    *----*----*    *----*----*