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

Question

lionfan

627

626もっと見る

500pt

コンピュータ

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

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.2

gong1971451702006/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

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

2006/06/17 08:59:50

cx20 2006/06/17 10:31:50

蛇足です。
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
lionfan 2006/06/17 11:13:23

cx20様、ありがとうございます!!
しばらく待って回答がつかなかったので、
非常に難しい質問だったのだ、とあきらめてしまったのです。
すごくうれしいです!!　本当に助かりました!!

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

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

リクエスト送信済

回答リクエストを送信したユーザーはいません

cx20 · Accepted Answer · 2006-06-17T01:51:55+09:00

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"(システム)

cx20 · Accepted Answer · 2006-06-17T01:51:55+09:00

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"(システム)

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

ベストアンサー

cx206071082006/06/17 01:51:55

その他の回答（1件）

cx206071082006/06/17 01:51:55ここでベストアンサー

gong1971451702006/06/17 02:14:36

コメント（2件)

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