PowoePointのフルスクリーンスライドショーの右クリックメニューにサブメニューを追加する。

前提・実現したいこと

パワーポイントのスライドショー実行中に使用するマクロを右クリックメニューから使用するために、右クリックメニューにContorolを追加しましたが、なぜかフルスクリーンスライドショーのときだけサブメニューが表示されません。
表示させる方法はないでしょうか？

発生している問題・エラーメッセージ

該当のソースコード

vba
1Sub Slideshow_End_False()
2Dim CommandBarItem As CommandBar
3    Dim CommandBarControlItem As CommandBarControl
4
5    'ずっと残るのでリセット
6    For Each CommandBarItem In Application.CommandBars
7        For Each CommandBarControlItem In CommandBarItem.Controls
8            On Error Resume Next: CommandBarControlItem.Reset: On Error GoTo 0
9        Next
10        On Error Resume Next: CommandBarItem.Reset: On Error GoTo 0
11    Next
12
13Dim Mymenubar As CommandBar
14    
15    Set Mymenubar = Commandbar_Id_Set(573)
16    Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = False
17    Call Menu_ADD(Mymenubar)
18
19    Set Mymenubar = Commandbar_Id_Set(941)
20    Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = False
21    Call Menu_ADD(Mymenubar)
22
23    Set Mymenubar = Commandbar_Id_Set(1790)
24    Mymenubar.Controls("スライド ショーの終了(&E)").Enabled = False
25    Call Menu_ADD(Mymenubar)
26
27End Sub
28Sub Menu_ADD(Mymenubar As CommandBar)
29Dim Newb As CommandBarControl
30Dim SubMenu As CommandBarControl
31    Set Newb = Mymenubar.Controls.Add()
32    With Newb
33        .Caption = "マクロを終了"
34        .OnAction = "MyEnd"
35    End With
36    
37    Set Newb = Mymenubar.Controls.Add(Type:=msoControlPopup)
38    With Newb
39        .Caption = "選択肢"
40    End With
41    Set SubMenu = Newb.Controls.Add
42    With SubMenu
43        .Caption = "10"
44        .State = False
45        .OnAction = "Rate10"
46    End With
47    Set SubMenu = Newb.Controls.Add
48    With SubMenu
49        .Caption = "9"
50        .State = False
51        .OnAction = "Rate09"
52    End With
53    Set SubMenu = Newb.Controls.Add
54    With SubMenu
55        .Caption = "8"
56        .State = False
57        .OnAction = "Rate08"
58    End With
59    Set SubMenu = Newb.Controls.Add
60    With SubMenu
61        .Caption = "7"
62        .State = False
63        .OnAction = "Rate07"
64    End With
65    Set SubMenu = Newb.Controls.Add
66    With SubMenu
67        .Caption = "6"
68        .State = False
69        .OnAction = "Rate06"
70    End With
71    Set SubMenu = Newb.Controls.Add
72    With SubMenu
73        .Caption = "5"
74        .State = False
75        .OnAction = "Rate05"
76    End With
77    Set SubMenu = Newb.Controls.Add
78    With SubMenu
79        .Caption = "4"
80        .State = False
81        .OnAction = "Rate04"
82    End With
83    Set SubMenu = Newb.Controls.Add
84    With SubMenu
85        .Caption = "3"
86        .State = False
87        .OnAction = "Rate03"
88    End With
89    Set SubMenu = Newb.Controls.Add
90    With SubMenu
91        .Caption = "2"
92        .State = False
93        .OnAction = "Rate02"
94    End With
95    Set SubMenu = Newb.Controls.Add
96    With SubMenu
97        .Caption = "1"
98        .State = False
99        .OnAction = "Rate01"
100    End With
101    Set SubMenu = Newb.Controls.Add
102    With SubMenu
103        .Caption = "0"
104        .State = False
105        .OnAction = "Rate00"
106    End With
107    Set SubMenu = Newb.Controls.Add
108    With SubMenu
109        .Caption = "-1"
110        .State = False
111        .OnAction = "Rate_01"
112    End With
113    Set SubMenu = Newb.Controls.Add
114    With SubMenu
115        .Caption = "-2"
116        .State = False
117        .OnAction = "Rate_02"
118    End With
119    Set SubMenu = Newb.Controls.Add
120    With SubMenu
121        .Caption = "-3"
122        .State = False
123        .OnAction = "Rate_03"
124    End With
125    Set SubMenu = Newb.Controls.Add
126    With SubMenu
127        .Caption = "-4"
128        .State = False
129        .OnAction = "Rate_04"
130    End With
131    Set SubMenu = Newb.Controls.Add
132    With SubMenu
133        .Caption = "-5"
134        .State = False
135        .OnAction = "Rate_05"
136    End With
137    Set SubMenu = Newb.Controls.Add
138    With SubMenu
139        .Caption = "-6"
140        .State = False
141        .OnAction = "Rate_06"
142    End With
143    Set SubMenu = Newb.Controls.Add
144    With SubMenu
145        .Caption = "-7"
146        .State = False
147        .OnAction = "Rate_07"
148    End With
149    Set SubMenu = Newb.Controls.Add
150    With SubMenu
151        .Caption = "-8"
152        .State = False
153        .OnAction = "Rate_08"
154    End With
155    Set SubMenu = Newb.Controls.Add
156    With SubMenu
157        .Caption = "-9"
158        .State = False
159        .OnAction = "Rate_09"
160    End With
161    Set SubMenu = Newb.Controls.Add
162    With SubMenu
163        .Caption = "-10"
164        .State = False
165        .OnAction = "Rate_10"
166    End With
167
168End Sub
169
170
171Function Commandbar_Id_Set(MyId As Long) As CommandBar
172Dim MyCommandBars As CommandBars
173Dim Mymenubar As CommandBar
174
175Set MyCommandBars = Application.CommandBars
176
177For Each Mymenubar In MyCommandBars
178    If Mymenubar.Id = MyId Then
179        Set Commandbar_Id_Set = Mymenubar
180    End If
181Next
182
183End Function
184
185

試したこと

以下のコードを実行し、改めてControlのIDを確認するとともに、追加できているか確認して結果をテキスト出力してみました。
スライドショー関連の右クリックメニューは、３つありますが、いずれもControlは追加されているものとして出力されましたので、フルスクリーンのスライドショーだけ見えていないだけでは？
と

VBA
1Sub tuika()
2    Dim CommandBarItem As CommandBar
3    Dim CommandBarControlItem As CommandBarControl
4    Dim Mychild As CommandBarControl
5    Dim MyAddMenu As CommandBarButton
6
7    For Each CommandBarItem In Application.CommandBars
8
9            On Error Resume Next
10            Set MyAddMenu = CommandBarItem.Controls.Add
11            MyAddMenu.Caption = "ID=" & CommandBarItem.Id
12
13            On Error GoTo 0
14            If MyAddMenu Is Nothing Then
15                a = a & CommandBarItem.Name & ",ID=" & CommandBarItem.Id & ",notAdd" & vbCrLf
16            Else
17                a = a & CommandBarItem.Name & ",ID=" & CommandBarItem.Id & vbCrLf
18            End If
19
20            For i = 1 To CommandBarItem.Controls.Count
21                Set Myitem = CommandBarItem.Controls.Item(i)
22                a = a & " " & Myitem.Caption & ",Visible=" & Myitem.Visible & ",Id=" & Myitem.Id & ",Type=" & Myitem.Type & vbCrLf
23                On Error Resume Next
24                For i2 = 1 To Myitem.Controls.Count
25                    Set Mychild = Myitem.Controls.Item(i2)
26                    a = a & "    " & Mychild.Caption & ",Visible=" & Mychild.Visible & ",Id=" & Mychild.Id & ",Type=" & Mychild.Type & vbCrLf
27                    Set Mychild = Nothing
28                Next i2
29                On Error GoTo 0
30            Next i
31            Set MyAddMenu = Nothing
32    Next
33
34Dim fso As Object
35Set fso = CreateObject("Scripting.FileSystemObject")
36Dim ts As Object
37Mypath = ActivePresentation.Path
38Mypath = Mypath & "\" & "menu.txt"
39Set ts = fso.CreateTextFile(Mypath, True, True)
40ts.Write (a) ' 書き込み
41ts.Close ' ファイルを閉じる
42End Sub
43