create toolbar when Excel VBA Open (extract from tool 1)

********** thisworkbook **********

Option Explicit

Private Const gs_toolbar_extract_rpt_a As String = "toolbar_extract_rpt_a"
Private Const gs_toolbar_extract_rpt_c As String = "toolbar_extract_rpt_c"
Private Const gs_toolbar_extract_rpt_e As String = "toolbar_extract_rpt_e"
Private Const gs_toolbar_tool_1 As String = "toolbar_tool_1"

Private Sub Workbook_Activate()
    On Error Resume Next
    
    Application.CommandBars(gs_toolbar_extract_rpt_a).Visible = True
    Application.CommandBars(gs_toolbar_extract_rpt_c).Visible = True
    Application.CommandBars(gs_toolbar_extract_rpt_e).Visible = True
End Sub

Private Sub Workbook_Deactivate()
    On Error Resume Next
    
    Application.CommandBars(gs_toolbar_extract_rpt_a).Visible = False
    Application.CommandBars(gs_toolbar_extract_rpt_c).Visible = False
    Application.CommandBars(gs_toolbar_extract_rpt_e).Visible = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    
    Call sub_RemoveToolBar(gs_toolbar_extract_rpt_a)
    Call sub_RemoveToolBar(gs_toolbar_extract_rpt_c)
    Call sub_RemoveToolBar(gs_toolbar_extract_rpt_e)
    Call sub_RemoveToolBar(gs_toolbar_tool_1)
  '  Call sub_remove_all_bars
End Sub

Private Sub Workbook_Open()
    gs_saved_path = ThisWorkbook.Path
   
    Call sub_RemoveToolBar(gs_toolbar_extract_rpt_a)
    Call sub_RemoveToolBar(gs_toolbar_extract_rpt_c)
    Call sub_RemoveToolBar(gs_toolbar_extract_rpt_e)
    Call sub_RemoveToolBar(gs_toolbar_tool_1)
    'Call sub_remove_all_bars
    
    'gs_toolbar_extract_rpt_a
    '============================================================================================
    Call sub_add_new_bar(gs_toolbar_extract_rpt_a)
    Call sub_add_new_button(as_bar_name:=gs_toolbar_extract_rpt_a, _
                            as_btn_caption:="Extract Report (A)", _
                            as_on_action:="'sub_extract_report ""A"" '", _
                            ai_face_id:=300, _
                            as_tip_text:="Extract Report A")
                    
    Call sub_add_new_button(as_bar_name:=gs_toolbar_extract_rpt_a, _
                            as_btn_caption:="Generate Text File (A)", _
                            as_on_action:="'sub_gen_text_file ""A"" '", _
                            ai_face_id:=139, _
                            as_tip_text:="Generate Text File A")

'    Call sub_add_new_button(as_bar_name:=gs_toolbar_extract_rpt_a, _
'                            as_btn_caption:="", _
'                            as_on_action:="'sub_RemoveToolBar ""toolbar_extract_report"" '", ai_face_id:=722, _
'                            as_tip_text:="Exit this toolbar")
    '============================================================================================
    
    'gs_toolbar_extract_rpt_c
    '============================================================================================
    Call sub_add_new_bar(gs_toolbar_extract_rpt_c)
    Call sub_add_new_button(as_bar_name:=gs_toolbar_extract_rpt_c, _
                            as_btn_caption:="Extract Report (C)", _
                            as_on_action:="'sub_extract_report ""C"" '", _
                            ai_face_id:=184, _
                            as_tip_text:="Extract Report C")
    Call sub_add_new_button(as_bar_name:=gs_toolbar_extract_rpt_c, _
                            as_btn_caption:="Generate Text File (C)", _
                            as_on_action:="'sub_gen_text_file ""C"" '", _
                            ai_face_id:=7, _
                            as_tip_text:="Generate Text File C")
    '============================================================================================
    
    'gs_toolbar_extract_rpt_e
    '============================================================================================
    Call sub_add_new_bar(gs_toolbar_extract_rpt_e)
    Call sub_add_new_button(as_bar_name:=gs_toolbar_extract_rpt_e, _
                            as_btn_caption:="Extract Report (E)", _
                            as_on_action:="'sub_extract_report ""E"" '", _
                            ai_face_id:=186, _
                            as_tip_text:="Extract Report E")
    Call sub_add_new_button(as_bar_name:=gs_toolbar_extract_rpt_e, _
                            as_btn_caption:="Generate Text File (E)", _
                            as_on_action:="'sub_gen_text_file ""E"" '", _
                            ai_face_id:=71, _
                            as_tip_text:="Generate Text File E")
    '============================================================================================
    
    'gs_toolbar_tool_1
    '============================================================================================
    Call sub_add_new_bar(gs_toolbar_tool_1)
    Call sub_add_new_button(as_bar_name:=gs_toolbar_tool_1, _
                            as_btn_caption:="Verify Length(by byte)", _
                            as_on_action:="sub_LenByBytes", _
                            ai_face_id:=101, _
                            as_tip_text:="Verify Length(by byte)")
    '============================================================================================
    
    Dim lo_conn
    
    For Each lo_conn In ThisWorkbook.Connections
        lo_conn.Delete
    Next
    
End Sub



*********module_commandbar ******

Option Explicit

Sub sub_add_new_bar(as_bar_name As String)
    Dim lcb_new_commdbar As CommandBar
        
    Call sub_RemoveToolBar(as_bar_name)
    
    Set lcb_new_commdbar = Application.CommandBars.Add(as_bar_name, msoBarTop)
    lcb_new_commdbar.Visible = True
    Set lcb_new_commdbar = Nothing
End Sub

Public Sub sub_RemoveToolBar(as_toolbar As String)
    On Error Resume Next
    
    Dim lcb_commdbar As CommandBar
    
    Set lcb_commdbar = Nothing
    
    Application.CommandBars(as_toolbar).Delete
    Application.CommandBars("Custom 1").Delete
End Sub

Sub sub_remove_all_bars()
    On Error Resume Next
    Dim tempbar As CommandBar

    For Each tempbar In Application.CommandBars
        'If tempbar.Name Like "my_bar*" Then
            tempbar.Delete
        'End If
    Next

End Sub

Public Sub sub_add_new_button(as_bar_name As String, as_btn_caption As String, _
                    as_on_action As String, ai_face_id As Integer, _
                    Optional as_tip_text As String)

    Dim lcb_commdbar As CommandBar
    Dim lbtn_new_button As CommandBarButton
    
    Set lcb_commdbar = Application.CommandBars(as_bar_name)
        
    Set lbtn_new_button = lcb_commdbar.Controls.Add(msoControlButton)
    With lbtn_new_button
        .Caption = as_btn_caption
        .Style = msoButtonIconAndCaptionBelow
        '.OnAction = "sub_RemoveToolBar"
        .OnAction = as_on_action
        .FaceId = ai_face_id
        .TooltipText = as_tip_text
        .BeginGroup = True
    End With
    
    Set lcb_commdbar = Nothing
    Set lbtn_new_button = Nothing
End Sub

'======================================================================================================






评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值