PowerPointのシェイプ(四角等)を右クリックしときに出る、

ポップアップメニューに「はてな」というメニューを追加するのは、
以下の3行のVBAでできます。

Sub Macro1()
CommandBars("Shapes").Controls.Add(Type:=msoControlPopup).Caption = "はてな"
End Sub

問題は、これでは「フリーフォーム」
(カクカク線)による閉図形を右クリックしても、
ポップアップメニューが出ない、ということなのです。
どのように修正したらよいか、ご教示いただけないでしょうか。

おそらく、 CommandBars("Shapes") の"Shapes" の部分を、
適切な言葉にすればいいのだと思いますが、それがわからないのです。
よろしくお願いいたします。

回答の条件
  • 1人2回まで
  • 登録:2006/06/17 00:13:58
  • 終了:2006/06/17 09:00:23

ベストアンサー

id:cx20 No.1

cx20回答回数607ベストアンサー獲得回数1082006/06/17 01:51:55

ポイント300pt

http://homepage2.nifty.com/DreamyCat/Wordcommandbars.htm

「フリーフォーム」は"Curve"で指定できるようです。

Sub Macro1()
  CommandBars("Curve").Controls.Add(Type:=msoControlPopup).Caption = "はてな"
End Sub

以下は参考情報です。

<ポップアップメニューの一覧を取得するサンプル>
Sub ShowPopupMenuList()
    Dim bar
    For Each bar In Application.CommandBars
        If bar.Type = msoBarTypePopup Then
            Debug.Print Chr(34) & bar.Name & Chr(34) & "(" & bar.NameLocal & ")"
        End If
    Next
End Sub
<実行結果>
"Shapes"(図形)
"Slider Sorter"(スライド一覧表示)
"Thumbnails"(縮小表示)
"Slide Gap"(スライドの間隔)
"Notes Pane"(ノート ペイン)
"Outliner"(アウトラインの作成)
"Slide Show"(スライド ショー)
"Slide Show Short Popup"(スライド ショー ショート ポップアップ)
"Nondefault Drag and Drop"(ドラッグ アンド ドロップ (既定以外))
"Curve"(曲線)
"OLE Object"(OLE オブジェクト)
"Connector"(コネクタ)
"WordArt Context Menu"(ワードアート ショートカット メニュー)
"Rotate Mode"(回転モード)
"Curve Segment"(線分を曲げる)
"Curve Node"(結節点を曲げる)
"ActiveX Control"(ActiveX コントロール)
"Spelling"(スペル チェック)
"Pictures Context Menu"(図ショートカット メニュー)
"Canvas Popup"(Canvas Popup)
"Script Anchor Popup"(スクリプト アンカーのポップアップ)
"Frames"(レイアウト枠)
"Notes View Slide"(ノート表示スライド)
"Slide Show Browse"(スライド ショーのブラウズ)
"Hyperlinked Object"(ハイパーリンクされたオブジェクト)
"Tables"(テーブル)
"Table Cells"(テーブル : セル)
"Organization Chart Popup"(Organization Chart Popup)
"Diagram"(ダイアグラム)
"OrgChart Text Edit PopUp"(OrgChart Text Edit PopUp)
"Comment Popup"(コメント ポップアップ)
"Slide View Ink Annotation Popup"(スライド ビューのインク注釈ポップアップ)
"Revision Marker Popup"(Revision Marker Popup)
"System"(システム)
id:lionfan

ありがとうございます!!

とぉっっっっても助かりました!!

2006/06/17 08:59:28

その他の回答(1件)

id:cx20 No.1

cx20回答回数607ベストアンサー獲得回数1082006/06/17 01:51:55ここでベストアンサー

ポイント300pt

http://homepage2.nifty.com/DreamyCat/Wordcommandbars.htm

「フリーフォーム」は"Curve"で指定できるようです。

Sub Macro1()
  CommandBars("Curve").Controls.Add(Type:=msoControlPopup).Caption = "はてな"
End Sub

以下は参考情報です。

<ポップアップメニューの一覧を取得するサンプル>
Sub ShowPopupMenuList()
    Dim bar
    For Each bar In Application.CommandBars
        If bar.Type = msoBarTypePopup Then
            Debug.Print Chr(34) & bar.Name & Chr(34) & "(" & bar.NameLocal & ")"
        End If
    Next
End Sub
<実行結果>
"Shapes"(図形)
"Slider Sorter"(スライド一覧表示)
"Thumbnails"(縮小表示)
"Slide Gap"(スライドの間隔)
"Notes Pane"(ノート ペイン)
"Outliner"(アウトラインの作成)
"Slide Show"(スライド ショー)
"Slide Show Short Popup"(スライド ショー ショート ポップアップ)
"Nondefault Drag and Drop"(ドラッグ アンド ドロップ (既定以外))
"Curve"(曲線)
"OLE Object"(OLE オブジェクト)
"Connector"(コネクタ)
"WordArt Context Menu"(ワードアート ショートカット メニュー)
"Rotate Mode"(回転モード)
"Curve Segment"(線分を曲げる)
"Curve Node"(結節点を曲げる)
"ActiveX Control"(ActiveX コントロール)
"Spelling"(スペル チェック)
"Pictures Context Menu"(図ショートカット メニュー)
"Canvas Popup"(Canvas Popup)
"Script Anchor Popup"(スクリプト アンカーのポップアップ)
"Frames"(レイアウト枠)
"Notes View Slide"(ノート表示スライド)
"Slide Show Browse"(スライド ショーのブラウズ)
"Hyperlinked Object"(ハイパーリンクされたオブジェクト)
"Tables"(テーブル)
"Table Cells"(テーブル : セル)
"Organization Chart Popup"(Organization Chart Popup)
"Diagram"(ダイアグラム)
"OrgChart Text Edit PopUp"(OrgChart Text Edit PopUp)
"Comment Popup"(コメント ポップアップ)
"Slide View Ink Annotation Popup"(スライド ビューのインク注釈ポップアップ)
"Revision Marker Popup"(Revision Marker Popup)
"System"(システム)
id:lionfan

ありがとうございます!!

とぉっっっっても助かりました!!

2006/06/17 08:59:28
id:gong1971 No.2

gong1971回答回数443ベストアンサー獲得回数682006/06/17 02:14:36

ポイント200pt

"Shapes" の部分を"Curve"に変えればOKです。

参考までに...

フリーフォームを右クリックした場合、4つめの「頂点の編集」が

特徴的ですよね。という訳で下記のコードを使用して調べてみました。

実行するとイミディエイト・ウィンドウ(画面下のペイン)にCommandBarsの

名前が表示されます。

For i = 1 To CommandBars.Count
    If CommandBars(i).Controls.Count >= 4 Then
        If InStr(CommandBars(i).Controls(4).Caption, "頂点の編集") > 0 Then
            Debug.Print CommandBars(i).Name
        End If
    End If
Next
id:lionfan

了解!! 助かりました。ありがとうございます!!

2006/06/17 08:59:50
  • id:cx20
    蛇足です。
    http://q.hatena.ne.jp/1150445888(キャンセルされた質問) の情報の取得方法が分かりました。
    以下のコードで取得できるようです(解決済みでしたらすみません。)

    ' フリーフォームの頂点座標(XY座標)を取得するサンプル
    Sub ShowFreeFormXYPoint()
      Dim slide
      For Each slide In ActiveWindow.Parent.Slides
        Dim shape
        For Each shape In slide.Shapes
          If shape.Type = msoFreeform Then
            Debug.Print "Name = [" & shape.Name & "]"
            Dim node
            For Each node In shape.Nodes
              Dim point
              point = node.Points
              Debug.Print "x = [" & point(1, 1) & "], y = [" & point(1, 2) & "]"
            Next
          End If
        Next
      Next
    End Sub

    <実行結果>
    Name = [Freeform 11]
    x = [246.125], y = [187.375]
    x = [223], y = [259.25]
    x = [146.875], y = [259.25]
    x = [208.625], y = [304.25]
    x = [185.375], y = [375.5]
    x = [246.125], y = [331.875]
    x = [306.875], y = [375.5]
    x = [283.625], y = [304.25]
    x = [345.375], y = [259.25]
    x = [269.375], y = [259.25]

    <参考情報>
    ■ 雲マークを作図したい
    http://www.keep-on.com/excelyou/2003lng4/200312/03120019.txt
  • id:lionfan
    cx20様、ありがとうございます!!
    しばらく待って回答がつかなかったので、
    非常に難しい質問だったのだ、とあきらめてしまったのです。
    すごくうれしいです!! 本当に助かりました!!

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません