当前位置:编程学习 > VB >>

调用菜单

请大家帮助解决,在窗体中,如何调用设计器中的菜单代码
窗体代码
Public xlBook As Excel.Workbook
Public xlSheet As Excel.Worksheet
Dim FileName As String
Dim b As String
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const EM_UNDO = &HC7
Private Declare Function OSWinHelp% Lib "User32" Alias "WinHelpA" (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Sub Command1_Click()
On Error Resume Next
    FileName = App.Path & "\Book1.xls"
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.Open (FileName), Password:=""
    Unload Me
    Set xlApp = Application
    Call 创建自定义菜单栏
'出现  编译错误  子程序或函数未定义
    xlApp.Visible = True 'EXCEL可见
End Sub
设计器中代码:
Implements IDTExtensibility2
Private WithEvents objButton1 As Office.CommandBarButton, WithEvents objButton2 As Office.CommandBarButton, WithEvents objButton3 As Office.CommandBarButton
Public xlApp As Excel.Application
Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
  Set xlApp = Application
  CreateMenus  '创建2003菜单
End Sub
Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
xlApp.CommandBars("Worksheet Menu Bar").Controls("【数据输入】").Delete
End Sub
Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)
End Sub
Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
End Sub
Private Sub 创建自定义菜单栏()
    On Error Resume Next
    xlApp.ScreenUpdating = False
    xlApp.CommandBars("Worksheet Menu Bar").Controls("【数据输入】").Delete
    With xlApp.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, Before:=10)
        .Caption = "【数据输入】"
        .Style = msoButtonIconAndCaption
            Set objButton1 = .Controls.Add(Type:=msoControlButton)
            With objButton1
                .Caption = "工程概况"
                .Style = msoButtonIconAndCaption
                .FaceId = 318
            End With
            Set objButton2 = .Controls.Add(Type:=msoControlButton)
            With objButton2
                .Caption = "土石方工程"
                .Style = msoButtonIconAndCaption
                .FaceId = 418
                .BeginGroup = True
            End With
            Set objButton3 = .Controls.Add(Type:=msoControlButton)
            With objButton3
                .Caption = "独立基础"
                .Style = msoButtonIconAndCaption
                .FaceId = 177
                .BeginGroup = True
            End With
        .Visible = True
    End With
    xlApp.ScreenUpdating = True
End Sub

Public Sub objButton1_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    MsgBox Prompt:="你点击的是【工程概况】", Buttons:=vbOKOnly + vbInformation, Title:="计算系统提示"
End Sub
Public Sub objButton2_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   MsgBox Prompt:="你点击的是【土石方工程】", Buttons:=vbOKOnly + vbInformation, Title:="计算系统提示"
End Sub
Public Sub objButton3_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   MsgBox Prompt:="你点击的是【独立基础】", Buttons:=vbOKOnly + vbInformation, Title:="计算系统提示"
End Sub

--------------------编程问答-------------------- 我也想知道,等待。。。。
补充:VB ,  基础类
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,