Excel vba Code für das Add-In
Funktion des Codes
Der folgende vba Makro Code installiert das klassischen Excel Addin als Symbole in der Excel-Menübar/Ribbonbar und führt die praktischen Funktionen zum Erstellen von Excel-Eingabeformularen auf.
Dabei werden die system-relevanten Datenblätter voll ausgeblendet und die Excelblätter gegen Veränderungen ausserhalb der Eingabezellen geschützt.
Vba-Code: der vba Code installiert Buttons unter Menüleiste (Ribbonbar)->Add-Ins->Benutzerdefinierte Symbolleisten
Zum Einblenden und Ausblenden von Systemblättern und zum Sperren der Eingabeblätter ausserhalb der Eingabezeilen.
Excel Add-In Installieren
Im vba-Code-Bereich Alt+F11:
Im Addin->Projekt->Diese Arbeitsmappe ist der vba Code, welcher die Symbole in der Ribbonbar einfügt
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 |
Menü-Funktionen
Unter VBAProject->Module->Modul1 findet man den vba Makro-Code, welcher von der Ribbonbar-Buttons ausgeführt wird.
Dort sind die Hilfsfunktionen als Sub-Funktionen gespeichert.
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 >============ |