Nochmal Symbolleiste umbenennen...
23.12.2004 10:43:00
Karsten
ich erstelle beim Öffnen einer Datei (über Mustervorlage) eine eigene Symbolleiste mit dem Namen der Datei. Diese Symbolleiste wird beim Schließen der Arbeitsmappe auch wieder gelöscht.
Wenn ich jedoch die Arbeitsmappe unter einem anderen Namen abspeichere, soll die Symbolleiste den Namen der neuen Datei bekommen, um sie während der Arbeit mit der Arbeitsmappe auch ansprechen zu können. Wie geht das? Ich habe meinen Code unten beigestellt.
Karsten
Public CalcStatus As Long
Private Sub Workbook_Open()
'eigene Symbolleiste anlegen für die Bohrprofilerstellung
Dim symb As CommandBar
Dim symbol As CommandBarButton
Dim Name As String
On Error Resume Next
Worksheets("Icons").Shapes("Profilzeichnen").Select
Name = ActiveWorkbook.Name
Set symb = Application.CommandBars.Add(Name, Position:=msoBarTop, Temporary:=True)
ActiveWindow.Zoom = 100
With symb
.Left = 0
.Visible = True
End With
CalcStatus = Application.Calculation
Application.Calculation = xlAutomatic
Set symbol = Application.CommandBars(Name).Controls.Add(Type:=msoControlButton)
With symbol
.Style = msoButtonIconAndCaption
.FaceId = 230
.Caption = "Projektdaten"
.TooltipText = "Eingabe der Projektdaten"
.BeginGroup = True
.OnAction = "ProjektdatenEingeben"
End With
Set symbol = Application.CommandBars(Name).Controls.Add(Type:=msoControlButton)
With symbol
.Style = msoButtonIconAndCaption
.FaceId = 162
.Caption = "Bohrungsdaten"
.TooltipText = "Eingabemaske der Bohrungs- und Schichtdaten"
.BeginGroup = True
.OnAction = "Testuserform"
End With
Set symbol = Application.CommandBars(Name).Controls.Add(Type:=msoControlButton)
Worksheets("Icons").Shapes("Profilzeichnen").Select
Selection.Copy
With symbol
.Style = msoButtonIconAndCaption
.PasteFace
.Caption = "Bohrprofil erstellen"
.TooltipText = "Bohrprofil"
.BeginGroup = True
.OnAction = "BohrprofilErstellen"
End With
Set symbol = Application.CommandBars(Name).Controls.Add(Type:=msoControlButton)
Worksheets("Icons").Shapes("Schichtenverzeichnis").Select
Selection.Copy
With symbol
.Style = msoButtonIconAndCaption
.PasteFace
.Caption = "Schichtenverzeichnis"
.TooltipText = "Erstellung von Schichtenverzeichnissen nach DIN 4022"
.BeginGroup = True
.OnAction = "SchichtenverzeichnisErstellen"
End With
Set symbol = Application.CommandBars(Name).Controls.Add(Type:=msoControlButton)
With symbol
.Style = msoButtonIconAndCaption
.FaceId = 279
.Caption = "Zwischenablage"
.TooltipText = "Kopieren der Grafik in die Zwischenablage"
.BeginGroup = True
.OnAction = "ZeichenobjekteKopieren"
End With
Set symbol = Application.CommandBars(Name).Controls.Add(Type:=msoControlButton)
With symbol
.Style = msoButtonIconAndCaption
.FaceId = 25
.Caption = "Grafikeinstellung"
.TooltipText = "Anpassen der Grafikausgabe an den Rechner"
.BeginGroup = True
.OnAction = "TestGrafik"
End With
Worksheets("Splash").Activate
End Sub
Private Sub Workbook_Activate()
'Symbolleiste bim Aktivieren der Mappe einblenden
On Error Resume Next
Application.CommandBars(Name).Enabled = True
CalcStatus = Application.Calculation
Application.Calculation = xlAutomatic
End Sub
Private Sub Workbook_Deactivate()
'Symbolleiste beim Wechseln auf anderes Blatt ausblenden
On Error Resume Next
Application.CommandBars(Name).Enabled = False
Application.Calculation = CalcStatus
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Beim Schließen der Datei die Symbolleiste wieder entfernen
On Error Resume Next
Application.CommandBars(Name).Delete
Application.Calculation = CalcStatus
End Sub