Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11128 / 76735 ←次へ | 前へ→

【71148】Re:アドインを登録して、メニュー表示
発言  kanabun  - 12/2/2(木) 13:44 -

引用なし
パスワード
   ▼りんご さん:こんにちは〜
>・階層化したメニューを表示、そこから実行

この部分に関してだけ。
カスタムメニューバーを作成し、そこに「階層化したメニュー」を
作成している例です。
この例では、プロシージャ↓は ThisWorkBook に書いています。
OnActionで 指定のマクロを呼び出すルーティンも 同じThisWorkbook
内に書いています。

Sub CustomMenu()
  Dim myCBar As CommandBar
  Const cbName = "User MenuBar"  '作成するメニューバーの名前
  
  On Error Resume Next
  Application.CommandBars(cbName).Delete
  On Error GoTo 0
  
  Set myCBar = Application.CommandBars.Add(Name:=cbName, _
    Temporary:=True)   
  
'-----[ファイル]メニューの作成 -----
  With myCBar.Controls.Add(Type:=msoControlPopup)
    .Caption = "ファイル(&F)"
   'サブメニュー[保存]コマンドの作成
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "保存(&S)"
      .OnAction = "ThisWorkbook.SaveBook"
    End With
   'サブメニュー[終了]コマンドの作成
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "終了(&Q)"
      .OnAction = "ThisWorkbook.QuitExcel"
    End With
    .BeginGroup = True     '区切り線の表示
  End With
  
'-----[オプション]メニューの作成 -----
  With myCBar.Controls.Add(Type:=msoControlPopup)
    .Caption = "オプション(&O)"
    .BeginGroup = True     '区切り線の表示
  
    'サブメニュー[Excelメニュー]コマンドの作成
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "Excelメニュー(&E)"
      .OnAction = "ThisWorkbook.ResetMenuBar"
    End With
  End With
  
'---- ツールバーの表示 -----
  With myCBar
    .Visible = True
    .Position = msoBarFloating ' msoBarTop
  End With
End Sub

Private Sub SaveBook()
  MsgBox "Save Book" 'プログラムを呼び出す
End Sub
Private Sub QuitExcel()
  MsgBox "Quit Excel" 'プログラムを実行
End Sub

Private Sub ResetMenuBar()
  MsgBox "Reset MenuBar" '処理を記述
End Sub
6 hits

【71144】アドインを登録して、メニュー表示 りんご 12/2/2(木) 10:56 質問
【71146】Re:アドインを登録して、メニュー表示 とおりすぎ 12/2/2(木) 11:59 回答
【71147】Re:アドインを登録して、メニュー表示 Jaka 12/2/2(木) 12:02 発言
【71148】Re:アドインを登録して、メニュー表示 kanabun 12/2/2(木) 13:44 発言
【71153】Re:アドインを登録して、メニュー表示 りんご 12/2/2(木) 17:38 お礼

11128 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free