'
' メニュ− マクロ
' ﾏｸﾛ作成日 :
'
Const dv As String = "b:"       '[1]実行するマクロの入っているドライブ
Const dr As String = "\VBAtest" '[2]実行するマクロの入っているディレクトリ−
Const mym As String = "Mymenyu" '[3]メニュ−バ−の名前

Dim er As Integer               'シ−トオ−プンをチェック
'
Sub auto_open()
'メニューバーの追加
    chkm = 0
    For Each barn In MenuBars
        If barn.Caption = mym Then
              MenuBars(mym).Activate
              chkm = 1
              Exit Sub
        End If
    Next
     If chkm = 0 Then
       MenuBars.Add mym
     End If
'
'メニューの追加
    With MenuBars(mym)
        With .Menus
            .Add "ﾌｧｲﾙ"
            .Add "HTMLへ変換"       '[4]実行内容が判るメニュ−
            .Add "ﾒﾆｭ-終了"
        End With
'
'メニュー項目の追加
        With .Menus("ﾌｧｲﾙ").MenuItems
            .Add "開く", "men10"
            .Add "閉じる", "men11"
            .Add "-"
            .Add "上書き保存", "men12"
            .Add "名前を付けて保存", "men13"
            .Add "-"
            .Add "Excelの終了", "men14"
        End With
        With .Menus("HTMLへ変換").MenuItems
            .Add "HTML変換スタ−ト", "men20"  '[5]実行内容が判る名前を付ける
            .Add "-"
            .AddMenu "メニュー項目"           '[6]サブメニュ−の記入例
        End With
        With .Menus("ﾒﾆｭ-終了").MenuItems
            .Add "excelに戻る", "men70"
            .Add "キャンセル"
        End With
'
'サブメニュウ項目の追加
        With .Menus("HTMLへ変換").MenuItems("メニュー項目").MenuItems
            .Add "サブメニュウ１", "men430"      '[7]サブメニュ−の記入例
            .Add "サブメニュウ２", "men431"
        End With
      End With
      
'メニュウバーの表示
     MenuBars(mym).Activate
End Sub
'
'
'
Sub men10()
    fname = Application.GetOpenFilename
      If fname = False Then
      Exit Sub
    End If
    Workbooks.Open filename:=fname
End Sub
Sub men11()
       ActiveWorkbook.Close
End Sub
Sub men12()
       ActiveWorkbook.Save
End Sub
Sub men13()
    fname = Application.GetSaveAsFilename
      ActiveWorkbook.SaveAs filename:=fname, FileFormat:=xlNormal, _
      Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
      , CreateBackup:=False
End Sub
Sub men14()
     Application.Quit
End Sub
'
Sub men20()                                                  '[8]指定されたマクロを実行
      Workbooks.Open filename:=dv & dr & "\cg_EXa.xls"
      Application.Run macro:="cg_EXa.xls!chengs"
End Sub

Sub men70()
    On Error Resume Next
    shsuu = Worksheets.Count
    For i = 1 To shsuu
      Worksheets(i).Activate
      If ActiveSheet.Type = xlWorksheet Then
         MenuBars(xlWorksheet).Activate
         er1 = 1
         Exit For
       End If
     Next
     If er1 = 0 Then
     Workbooks.Add
     MenuBars(xlWorksheet).Activate
     End If
     On Error GoTo 0
End Sub