Sub MyShapeByVal()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem オートシェイプ設定値 引き渡し処理
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Excel VBA
  Rem 機能...
  Rem   オートシェイプの設定値を、コマンドボタンのポップヒントを介して、
  Rem   他のプロシージャに引き渡す。
  Rem 注記...
  Rem   1. 手作業で、オートシェイプを右クリックして[マクロの登録...]に下記を入力。
  Rem     （単一引用符で囲んで入力。）
  Rem     例...
  Rem     「'CommandBars("MyShapeByVal").Controls(1).TooltipText = "222": CommandBars("MyShapeByVal").Controls(1).Execute'」
  Rem    （コマンドバーのポップヒントに「222」を設定する例。）
  Rem   2. 実行前に「MyShapeByValInit」を一度実行しておくこと。
  Rem   3. セキュリティレベルを「低」に設定すること（あるいは署名で対処）。
  Rem   4. オートシェイプをクリックして実行。
  Rem 履歴...
  Rem   第01版：2007/02/02：作成。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem コマンドバー「MyShapeByVal」のコマンドボタンのポップヒントを取得。
  MsgBox CommandBars("MyShapeByVal").Controls(1).TooltipText
End Sub ' MyShapeByVal *----*----*    *----*----*    *----*----*    *----*----*

Sub MyShapeByValInit()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem オートシェイプ設定値引き渡し処理：初期処理
  Rem 機能...
  Rem   設定値引き渡し用の浮動コマンドバーを非表示で追加。
  Rem 注記...
  Rem   1. 「MyShapeByVal」を実行する前に一度実行する。
  Rem   2. アプリケーション終了時まで有効。
  Rem   3. 「OnAction」にマクロ「MyShapeByVal」の保存先を指定すること。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttn As CommandBarControl
  '
  On Error Resume Next
  CommandBars("MyShapeByVal").Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:="MyShapeByVal", Position:=msoBarFloating, Temporary:=True)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  '
  With myCtrlBttn
    .DescriptionText = "ポップアップメニュー"
    .Style = msoButtonIconAndCaption
    .Caption = "MyShapeByVal実行"
    .TooltipText = "?????" ' ここに引き渡す値を設定する。
    .FaceId = 329
    .OnAction = "PERSONAL.XLS!MyShapeByVal.MyShapeByVal" ' マクロ保存先を指定。
  End With
  '
  ' myCmmdBar.Visible = True ' 画面上に表示（通常は表示不要）。
End Sub ' MyShapeByValInit *----*----*    *----*----*    *----*----*    *----*----*