Sub MyRangeScaling()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 選択文字列 文字幅倍率 設定処理
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能：選択した文字列の文字幅に設定する。
  Rem 注記：MyRangeScalingを起動して使用｡
  Rem 履歴...
  Rem   第1版：2004/02/01：作成。
  Rem   第2版：2007/02/01：バルーン表示を廃止。ツールバー表示に変更。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "MyRangeScaling"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  On Error Resume Next
  CommandBars(myTitle).Delete
  On Error GoTo 0
  '
  Call MyRangeScalingBlln(myTitle)
End Sub ' MyRangeScaling  *----*----*    *----*----*    *----*----*    *----*----*

Sub MyRangeScalingBlln(myTitle As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem ツールバー表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttnExec As CommandBarControl
  Dim myCtrlCboxItem As CommandBarControl
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=True)
  Set myCtrlBttnExec = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlComboBox, Before:=2, Temporary:=True)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrlBttnExec
    .DescriptionText = "選択した文字列の文字幅に設定します。"
    .Style = msoButtonIcon
    .Caption = "実行"
    .TooltipText = "文字幅 設定！"
    .FaceId = 386
    .OnAction = "MyRangeScalingBttnExec"
  End With
  '
  With myCtrlCboxItem
    .DescriptionText = "文字幅を選択します。"
    .Style = msoComboNormal
    .Caption = "文字幅"
    '
    .AddItem "200%", 1
    .AddItem "150%", 2
    .AddItem "100%", 3
    .AddItem "90%", 4
    .AddItem "80%", 5
    .AddItem "66%", 6
    .AddItem "50%", 7
    .AddItem "33%", 8
    '
    .ListIndex = 3
    .TooltipText = "文字幅を選択して下さい。"
    .DropDownWidth = 300
    .OnAction = "MyRangeScalingCboxItem"
  End With
  '
  myCmmdBar.Visible = True
End Sub ' MyRangeScalingBlln  *----*----*    *----*----*    *----*----*    *----*----*

Sub MyRangeScalingBttnExec(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [実行]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myScaling As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "MyRangeScaling"
  '
  If Selection.Range.Text = "" Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myScaling = Val(CommandBars(myTitle).Controls(2).Text)
  Selection.Font.Scaling = myScaling
  Selection.Collapse wdCollapseEnd
End Sub ' MyRangeScalingBttnExec *----*----*    *----*----*    *----*----*    *----*----*

Sub MyRangeScalingCboxItem(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [文字幅]コンボボックス処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "MyRangeScaling"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With CommandBars(myTitle).Controls(2)
    .TooltipText = .Text
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  If Selection.Range.Text = "" Then Exit Sub
  '
  CommandBars(myTitle).Controls(1).Execute
End Sub ' MyRangeScalingCboxItem *----*----*    *----*----*    *----*----*    *----*----*