Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
768to772
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Symbolleiste für nur eine bestimmte Datei

Symbolleiste für nur eine bestimmte Datei
28.05.2006 12:58:27
Micha
Hallo Leute,
ich möchte gern eine spezielle Symbolleiste bauen, welche sich nur in einer bestimmten Datei befinden soll. Wenn ich die Tabelle auf einem anderen Rechner ansehen will, muss die Symbolleiste auch da sein. Mache ich eine andere Tabelle auf, soll von der Symbolleiste nix zu sehen sein.
Ich will also die Symbolleiste an die Tabelle "heften". Wie kann ich das machen?
Danke Euch für die Hilfe.
Gruß Micha

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Symbolleiste für nur eine bestimmte Datei
28.05.2006 13:49:11
Josef
Hallo Micha!
Guckst Du: Symbolleisten (2) - Erzeugen und mehr!
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Symbolleiste für nur eine bestimmte Datei
28.05.2006 16:06:42
Micha
Hallo Sepp,
danke erst einmal. Aber da blicke ich net durch. Geht das auch etwas einfacher?
Gruß Micha
Anzeige
AW: Symbolleiste für nur eine bestimmte Datei
28.05.2006 18:43:33
Josef
Hallo Micha!
Mal ein einfaches Beispiel!
Achte darauf welcher Code wohin gehört!
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Activate()
If Not objCBar Is Nothing Then
  objCBar.Visible = True
Else
  MakeMyBar
End If
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not objCBar Is Nothing Then Set objCBar = Nothing
DeleteMyBar
End Sub


Private Sub Workbook_Deactivate()
If Not objCBar Is Nothing Then objCBar.Visible = False
End Sub


Private Sub Workbook_Open()
MakeMyBar
End Sub


' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
Option Private Module

Public objCBar As CommandBar
Const strBarName As String = "Meine Leiste" ' Name der Symbolleiste - Anpassen!

Sub MakeMyBar()
Dim objCBtn As CommandBarButton

DeleteMyBar

Set objCBar = Application.CommandBars.Add(Name:=strBarName, Position:=msoBarTop, Temporary:=True)

Set objCBtn = objCBar.Controls.Add(msoControlButton)

With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Erster"
  .FaceId = 59
  .OnAction = "Makro1"
End With

Set objCBtn = objCBar.Controls.Add(msoControlButton)

With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Zweiter"
  .FaceId = 276
  .OnAction = "Makro2"
End With

Set objCBtn = Nothing

objCBar.Visible = True

End Sub


Sub DeleteMyBar()
On Error Resume Next
Application.CommandBars(strBarName).Delete
On Error GoTo 0
End Sub


Sub Makro1()
MsgBox "Hallo!" & vbLf & "Ich bin Makro 1!"
End Sub


Sub Makro2()
MsgBox "Hallo!" & vbLf & "Ich bin Makro 2!"
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Symbolleiste für nur eine bestimmte Datei
30.05.2006 19:23:27
Micha
Hallo Sepp,
klasse, es läuft. Ich habe es leider erst jetzt probiert. Aber ist super. Ich habe mal noch zwei Fragen:
1. Kann ich auch mit Untermenüs arbeiten?
2. Kann ich die Leiste auch noch positionieren?
Danke für deine tolle Unterstützung.
Gruß Micha
AW: Symbolleiste für nur eine bestimmte Datei
30.05.2006 23:04:01
Josef
Hallo Micha!
Ein Beispiel mit Untermenüs!
Die Position der Symbolleiste wird beim Beenden der Datei in der Registry gespeichert
und beim nächsten Erstellen wieder hergestellt!
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Activate()
If Not objCBar Is Nothing Then
  objCBar.Visible = True
Else
  MakeMyBar
End If
End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)
MyBar_SaveSettings
End Sub



Private Sub Workbook_Deactivate()
If Not objCBar Is Nothing Then objCBar.Visible = False
End Sub



Private Sub Workbook_Open()
MakeMyBar
End Sub


' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
Option Private Module

Public objCBar As CommandBar
Const strBarName As String = "Meine Leiste" ' Name der Symbolleiste - Anpassen!
Const cREG_APP As String = "ExcelBar"
Const cREG_TOOLBAR As String = "Einstellungen"

Sub MakeMyBar()
Dim objCBtn As CommandBarButton
Dim objCPop As CommandBarPopup, objCBPop As CommandBarPopup

MyBar_SaveSettings

Set objCBar = Application.CommandBars.Add(Name:=strBarName, Position:=msoBarTop, Temporary:=True)

Set objCBtn = objCBar.Controls.Add(msoControlButton)

With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Erster"
  .FaceId = 59
  .OnAction = "Makro1"
End With

Set objCPop = objCBar.Controls.Add(msoControlPopup)

objCPop.Caption = "Mehr..."

Set objCBtn = objCPop.Controls.Add(msoControlButton)

With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Zweiter"
  .FaceId = 276
  .OnAction = "Makro2"
End With

Set objCBtn = objCPop.Controls.Add(msoControlButton)

With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Dritter"
  .FaceId = 295
  .OnAction = "Makro3"
End With

Set objCBPop = objCPop.Controls.Add(msoControlPopup)

With objCBPop
  .Caption = "Mehr..."
End With

Set objCBtn = objCBPop.Controls.Add(msoControlButton)

With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Vierter"
  .FaceId = 631
  .OnAction = "Makro4"
End With

Set objCBtn = objCBPop.Controls.Add(msoControlButton)

With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Fünfter"
  .FaceId = 378
  .OnAction = "Makro5"
End With

Set objCBtn = Nothing
Set objCPop = Nothing

On Error Resume Next
'Position aus Registry lesen
With objCBar
  .Width = Cint(GetSetting( _
    cREG_APP, cREG_TOOLBAR, "Width", .Width))
  .Position = Clng(GetSetting( _
    cREG_APP, cREG_TOOLBAR, "Position", msoBarTop))
  .Top = Clng(GetSetting(cREG_APP, cREG_TOOLBAR, "Top", .Top))
  .Left = Clng(GetSetting( _
    cREG_APP, cREG_TOOLBAR, "Left", .Left))
  .RowIndex = Clng(GetSetting( _
    cREG_APP, cREG_TOOLBAR, "RowIndex", .RowIndex))
  
  .Visible = Cbool(GetSetting( _
    cREG_APP, cREG_TOOLBAR, "Visible", -1))
  .Protection = msoBarNoCustomize
End With
On Error GoTo 0

End Sub


Private Sub MyBar_SaveSettings()
Dim lngPosition As Long
Dim blnVisible As Boolean
'Position in Registry speichern
On Error Resume Next
If Not objCBar Is Nothing Then
  With objCBar
    lngPosition = .Position
    blnVisible = .Visible
    
    SaveSetting cREG_APP, cREG_TOOLBAR, "Visible", _
      Clng(.Visible)
    SaveSetting cREG_APP, cREG_TOOLBAR, "Position", .Position
    SaveSetting cREG_APP, cREG_TOOLBAR, "Top", .Top
    SaveSetting cREG_APP, cREG_TOOLBAR, "Left", .Left
    SaveSetting cREG_APP, cREG_TOOLBAR, "RowIndex", .RowIndex
    
    .Visible = False
    .Position = msoBarFloating
    SaveSetting cREG_APP, cREG_TOOLBAR, "Width", .Width
    
    .Position = lngPosition
    .Visible = blnVisible
    .Delete
  End With
  Set objCBar = Nothing
Else
  Application.CommandBars(strBarName).Delete
End If
On Error GoTo 0
End Sub


Sub Makro1()
MsgBox "Hallo!" & vbLf & "Ich bin Makro 1!"
End Sub


Sub Makro2()
MsgBox "Hallo!" & vbLf & "Ich bin Makro 2!"
End Sub


Sub Makro3()
MsgBox "Hallo!" & vbLf & "Ich bin Makro 3!"
End Sub


Sub Makro4()
MsgBox "Hallo!" & vbLf & "Ich bin Makro 4!"
End Sub


Sub Makro5()
MsgBox "Hallo!" & vbLf & "Ich bin Makro 5!"
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige