Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
936to940
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
936to940
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Symbolleiste erweitern

Symbolleiste erweitern
05.01.2008 15:06:41
erik
hallo,
ich suche für diesen vba code (im netz aufgestöbert) noch eine erweiterung.
in case 4 soll zusätzlich der standard excel befehl "Werte einfügen" mit icon (id 370)
aufgenommen werden.
kann jemand helfen ?
erik

Private Sub Workbook_Open()
Dim CB As CommandBar
Dim CBC As CommandBarButton
Dim i%
On Error Resume Next
' Msgbox erzeugen
'Dim Mldg, Stil, Titel, Hilfe, Ktxt, Antwort, Text1
'  Mldg = "Sollen die Daten aktualisiert werden?"    ' Meldung definieren.
' Stil = vbYesNo '+ vbCritical + vbDefaultButton2    ' Schaltflächen
' definieren.
'Titel = "Datenaktualisierung"    ' Titel definieren.
'Hilfe = "DEMO.HLP"    ' Hilfedatei
' definieren.
'Ktxt = 1000    ' Kontext für Thema
' definieren.
'Antwort = MsgBox(Mldg, Stil, Titel, Hilfe, Ktxt)    ' Meldung anzeigen.
'If Antwort = vbYes Then    ' Benutzer hat "Ja"
' gewählt.
'Text1 = "Ja"
'Call Werte_holen ' Operation ausführen.
'Else    ' Benutzer hat "Nein"
' gewählt.
'Text1 = "Nein"
'MsgBox ("nein") ' Operation ausführen.
'End If
Set CB = Application.CommandBars.Add(Name:="Formatieren", _
temporary:=True, Position:=msoBarTop)
' Oben      Position:=msoBarTop
' Rechts    Position:=msoBarRight
' Links     Position:=msomsoBarLeft
' unten     Position:=msoBarBottom
On Error GoTo 0
If Application.CommandBars("Formatieren").Visible = False Then
CB.Visible = True
' cb.Left = 10
' cb.Top = 150
For i = 1 To 3
Set CBC = CB.Controls.Add(Type:=msoControlButton)
With CBC
.Width = 50                 ' Breite der Schalter
' .Style = msoButtonCaption   ' Text auf Schaltfläche ohne Icon
.Style = msoButtonIconAndCaption    ' Text und Icon
'                 Text Waagerecht für Links und Rechts
'                .Style = msoButtonWrapCaption
Select Case i
Case 1
.FaceId = 220    ' Icon vor Beschriftung
.Caption = "E/A Assistent"
.OnAction = "EA"
.TooltipText = "Merkmale bzw. Spalten ein !"
Case 2
.FaceId = 636   ' Icon vor Beschriftung
.Caption = "Spaltenbreite"
.OnAction = "B"
.TooltipText = "Für gewählten Zellbreich Spaltenbreite optimieren !"
Case 3
.FaceId = 4087
.Caption = "www.bauliste.de"
.OnAction = "BL"
.TooltipText = "Link zu Infodatenbank bauliste.de"
End Select
End With
Next i
End If
End Sub


1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Symbolleiste erweitern
05.01.2008 20:32:00
Herby
Hallo erik,
ich hab mal die For i = 1 to 4 angepasst und das fehlende "Case 4" eingefügt.

Private Sub Workbook_Open()
Dim CB As CommandBar
Dim CBC As CommandBarButton
Dim i%
On Error Resume Next
' Msgbox erzeugen
'Dim Mldg, Stil, Titel, Hilfe, Ktxt, Antwort, Text1
'  Mldg = "Sollen die Daten aktualisiert werden?"    ' Meldung definieren.
' Stil = vbYesNo '+ vbCritical + vbDefaultButton2    ' Schaltflächen
' definieren.
'Titel = "Datenaktualisierung"    ' Titel definieren.
'Hilfe = "DEMO.HLP"    ' Hilfedatei
' definieren.
'Ktxt = 1000    ' Kontext für Thema
' definieren.
'Antwort = MsgBox(Mldg, Stil, Titel, Hilfe, Ktxt)    ' Meldung anzeigen.
'If Antwort = vbYes Then    ' Benutzer hat "Ja"
' gewählt.
'Text1 = "Ja"
'Call Werte_holen ' Operation ausführen.
'Else    ' Benutzer hat "Nein"
' gewählt.
'Text1 = "Nein"
'MsgBox ("nein") ' Operation ausführen.
'End If
Set CB = Application.CommandBars.Add(Name:="Formatieren", _
temporary:=True, Position:=msoBarTop)
' Oben      Position:=msoBarTop
' Rechts    Position:=msoBarRight
' Links     Position:=msomsoBarLeft
' unten     Position:=msoBarBottom
On Error GoTo 0
If Application.CommandBars("Formatieren").Visible = False Then
CB.Visible = True
' cb.Left = 10
' cb.Top = 150
For i = 1 To 4
Set CBC = CB.Controls.Add(Type:=msoControlButton)
With CBC
.Width = 50                 ' Breite der Schalter
' .Style = msoButtonCaption   ' Text auf Schaltfläche ohne Icon
.Style = msoButtonIconAndCaption    ' Text und Icon
'                 Text Waagerecht für Links und Rechts
'                .Style = msoButtonWrapCaption
Select Case i
Case 1
.FaceId = 220    ' Icon vor Beschriftung
.Caption = "E/A Assistent"
.OnAction = "EA"
.TooltipText = "Merkmale bzw. Spalten ein !"
Case 2
.FaceId = 636   ' Icon vor Beschriftung
.Caption = "Spaltenbreite"
.OnAction = "B"
.TooltipText = "Für gewählten Zellbreich Spaltenbreite optimieren !"
Case 3
.FaceId = 4087
.Caption = "www.bauliste.de"
.OnAction = "BL"
.TooltipText = "Link zu Infodatenbank bauliste.de"
Case 4
.FaceId = 370
.Caption = "Werte einfügen"
.OnAction = "Makro1"
.TooltipText = "Excelbefehl Werte einfügen wird ausgeführt"
End Select
End With
Next i
End If
End Sub


Nun fehlt nur noch das Makro1, das die Werte einfügt. Dazu habe ich beispielsweise
ein Makro aufgezeichnet:
Sub Makro1()
Range("A23:C26").Select
Application.CutCopyMode = False
Selection.Copy
Range("E23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub


Um dieses Makro für deinen Bedarf zu ändern, muß vorher der zu kopierende Bereich
definiert werden (vielleicht ist er konstant oder variabel. Das weiss ich leider nicht.
Viele Grüße
Herby

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige