Excel vba code for the add-in
Function of the code
The following vba macro code installs the classic Excel Addin as icons in the Excel menu bar / Ribbonbar and lists the convenient features for creating Excel input forms.
The system-relevant data sheets are completely hidden and the Excel sheets are protected against changes outside the input cells.
Vba code: the vba code installs buttons under menu bar (Ribbonbar) -> Add-ins-> Custom Toolbars
For showing and hiding system sheets and for locking the input sheets outside the input lines.
Install Excel Add-In
In the vba code area Alt + F11:
In Addin-> Project-> This workbook is the vba code which inserts the icons in the Ribbonbar
Option Explicit On
Private Const MenuName As String = "TEST3" Private Const APPNAME As String = "APP3"
'======< Workbook >======
Private Sub Workbook_AddinInstall() Create_Ribbonbar_Addin_Button() End Sub Private Sub Workbook_Open() Create_Ribbonbar_Addin_Button() End Sub '======</ Workbook >======
Private Sub Create_Ribbonbar_Addin_Button() '------------< Create_Ribbonbar_Addin_Button() >------------ '-< Set Ribbonbar_Addin >- On Error Resume Next Application.CommandBars(MenuName).Delete On Error GoTo 0 Dim addin_Menu As CommandBar Set addin_Menu = Application.CommandBars.Add(MenuName, msoBarTop) addin_Menu.Visible = True '-</ Set Ribbonbar_Addin >-
'-< create button >- Dim btn As CommandBarButton Set btn = addin_Menu.Controls.Add(Type:=msoControlButton) btn.Caption = "Emails senden.." btn.OnAction = "Menu_Emails_senden" btn.FaceId = 5622 btn.Style = msoButtonIconAndCaptionBelow '-</ create button >-
'-< btn: Ausblenden >- Set btn = addin_Menu.Controls.Add(Type:=msoControlButton) btn.Caption = "Ausblenden" btn.OnAction = "Menu_Lock" btn.FaceId = 2173 btn.Style = msoButtonIconAndCaptionBelow '-</ btn: Ausblenden >-
'-< btn: Ausblenden >- Set btn = addin_Menu.Controls.Add(Type:=msoControlButton) btn.Caption = "Einblenden" btn.OnAction = "Menu_Unlock" btn.FaceId = 2174 btn.Style = msoButtonIconAndCaptionBelow '-</ btn: Ausblenden >-
'------------</ Create_Ribbonbar_Addin_Button() >------------ End Sub
|
Menu Functions
Under VBAProject-> Module-> Module1 you will find the vba macro code, which is executed by the Ribbonbar buttons.
There the auxiliary functions are stored as sub-functions.
Option Explicit On
'============< variables >============ Private Const °const_Password As String = "CodeDocu_de" '============</ variables >============
'============< Menu >============ Public Sub Menu_Emails_senden() MsgBox("Emails_senden") End Sub
Public Sub Menu_Lock() '--------< Menu_Lock() >-------- hide_all_System_Worksheets() Protect_Worksheets() '--------</ Menu_Lock() >-------- End Sub
Public Sub Menu_Unlock() '--------< Sys_Unlock() >-------- '*show: show all hidden and very hidden files show_all_Worksheets() Unprotect_Worksheets() '--------</ Einblenden() >-------- End Sub '============</ Menu >============
'============< Functions >============ Public Sub hide_all_System_Worksheets() '--------< hide_all_System_Worksheets() >-------- '*hide all worksheets where name starts with _ '*hide: very hidden Dim wb As Workbook Set wb = ActiveWorkbook Dim ws As Worksheet For Each ws In wb.Sheets If ws.Name Like "_*" Then ws.Visible = xlSheetVeryHidden End If Next '--------</ hide_all_System_Worksheets() >-------- End Sub
Public Sub show_all_Worksheets() '--------< show_all_Worksheets() >-------- '*show: show all hidden and very hidden files Dim wb As Workbook Set wb = ActiveWorkbook Dim ws As Worksheet For Each ws In wb.Sheets If ws.Name Like "_*" Then ws.Visible = xlSheetVisible End If Next '--------</ show_all_Worksheets() >-------- End Sub
Public Sub Protect_Worksheets() '--------< Protect_Worksheets() >-------- '*hide all worksheets where name starts with _ '*hide: very hidden On Error Resume Next
Dim wb As Workbook Set wb = ActiveWorkbook Dim ws As Worksheet For Each ws In wb.Sheets If ws.Visible = xlSheetVisible Then '*protect all visible worksheets ws.Protect °const_Password End If Next '--------</ Protect_Worksheets() >-------- End Sub
Public Sub Unprotect_Worksheets() '--------< Unprotect_Worksheets() >-------- 'unprotect all worksheets On Error Resume Next
Dim wb As Workbook Set wb = ActiveWorkbook Dim ws As Worksheet For Each ws In wb.Sheets If ws.Visible = xlSheetVisible Then '*protect all visible worksheets ws.Unprotect °const_Password End If Next '--------</ Unprotect_Worksheets() >-------- End Sub
'============</ Functions >============
|