Symboleisten Anordnung!
17.11.2005 12:18:47
Swen
ich habe mir eine Symboleiste gebaut mit der ich Funktionen aufrufen kann,
leider würde ich jetzt gerne eine weitere Spalte aufmachen recht von der
bestehenden um nochmehr Funktionen bzw. besser sortieren zu können!
In meiner jetzigen Symboleiste stehen alle Funktionen unter einander oder teilweise öffnet sich nach rechts eine weitere auswahl. Wie könnte ich z.B.
die unteren 4 Funktienen in eine weitere Spalte brinegen?
Hier mein derzeitiger Code:
Sub menü_deutsch()
Dim strText(1 To 35) As String
Dim lngZeileSprache As Long
For lngZeileSprache = 481 To 502
strText(lngZeileSprache - 480) = wrsSprache.Cells(lngZeileSprache, 1).Value
Next
strText(23) = wrsSprache.Cells(610, 1).Value
strText(24) = wrsSprache.Cells(611, 1).Value
strText(25) = wrsSprache.Cells(612, 1).Value
strText(26) = wrsSprache.Cells(613, 1).Value
strText(27) = wrsSprache.Cells(614, 1).Value
strText(28) = wrsSprache.Cells(652, 1).Value
strText(29) = wrsSprache.Cells(657, 1).Value
strText(30) = wrsSprache.Cells(661, 1).Value
strText(31) = wrsSprache.Cells(659, 1).Value
strText(32) = wrsSprache.Cells(446, 1).Value
strText(20) = wrsSprache.Cells(4, 1).Value
strText(33) = wrsSprache.Cells(663, 1).Value
strText(34) = wrsSprache.Cells(664, 1).Value
strText(35) = wrsSprache.Cells(667, 1).Value
'******** Symbolleiste erzeugen ***********************************************'
Dim CB As CommandBar ' Variable für Symbolleiste
Dim CBC As CommandBarButton ' Variable für Button
Dim i As Integer ' Variable für Schleife
On Error Resume Next
On Error Resume Next
Set CB = Application.CommandBars.Add(Name:="FPC_Design_D", _
temporary:=True, Position:=msoBarTop)
' temporary:=True Symbolleiste ist flüchtig, wird beim schließen von
' Excel gelöscht
' Oben Position:=msoBarTop
' Rechts Position:=msoBarRight
' Links Position:=msomsoBarLeft
' unten Position:=msoBarBottom
If Err.Number <> 0 Then ' Symbolleiste schon vorhanden
Application.CommandBars.Add(Name:="FPC_Design_D").Visible = True
Exit Sub
End If
On Error GoTo 0
' If Application.CommandBars("FPC_Design").Visible = False Then
CB.Visible = True
' Position der Symbolleiste vo Links
'CB.Left = 600
' position der Symbolleiste von oben falls Position:=... nicht angegeben
CB.Top = 250
' Wort mit Untermenü
On Error Resume Next
' Menü löschen falls schon vorhanden
Application.CommandBars("FPC_Design_D").Controls("Menü").Delete
On Error GoTo 0
With Application.CommandBars("FPC_Design_D").Controls.Add(Type:=msoControlPopup)
.BeginGroup = True 'Trennlinie
On Error GoTo 0
.Caption = "FPC_Design_D"
' erster Menüpunkt
With .Controls.Add
.FaceId = 612
.Caption = strText(2)
.OnAction = "Modul_Funktion_Symbol.Hauptmenü"
End With
' Zweiter Menüpunkt
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 71
.Caption = strText(3)
.OnAction = "Modul_WS_CoorErstellen.Tabelle_Coor_Erstellen"
End With
' 3. Menüpunkt
With .Controls.Add
.FaceId = 72
.Caption = strText(4)
.OnAction = "Modul_Funktion_Symbol.Header"
End With
' Untermenü erzeugen:
' vierter Menüpunktmit Untermenü
With .Controls.Add(Type:=msoControlPopup)
' Trennlinie
.BeginGroup = True
.Caption = strText(29)
With .Controls.Add
.FaceId = 73
.Caption = strText(24)
.OnAction = "Modul_Funktion_DesignAblauf.Step8"
End With
With .Controls.Add
.FaceId = 73
.Caption = strText(5)
.OnAction = "Modul_Funktion_Symbol.Dateneingabe"
End With
With .Controls.Add
.FaceId = 73
.Caption = strText(23)
.OnAction = "Modul_Funktion_DesignAblauf.Step7"
End With
End With
' Untermenü erzeugen:
' sechster Menüpunktmit Untermenü
With .Controls.Add(Type:=msoControlPopup)
' Trennlinie
.BeginGroup = True
.Caption = strText(6)
With .Controls.Add
.FaceId = 74
.Caption = strText(8)
.OnAction = "Modul_Funktion_Symbol.Berechnung"
End With
With .Controls.Add
.FaceId = 74
.Caption = strText(9)
.OnAction = "Modul_Funktion_Symbol.ohneBerechnung"
End With
End With
' siebter Menüpunkt
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 75
.Caption = strText(10)
.OnAction = "Modul_Funktion_Symbol.NR"
End With
' Achter Menüpunkt
With .Controls.Add
.FaceId = 76
.Caption = strText(11)
.OnAction = "Modul_Funktion_Symbol.layout1"
End With
' Neunter Menüpunkt
With .Controls.Add
.FaceId = 77
.Caption = strText(12)
.OnAction = "Modul_Funktion_Symbol.layout2"
End With
'zehnter Menüpunkt
With .Controls.Add
.FaceId = 78
.Caption = strText(13)
.OnAction = "Modul_Funktion_Symbol.zusatzseiten"
End With
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 79
.Caption = strText(25)
.OnAction = "Modul_Funktion_Speichern.sortieren_2"
End With
'elfter Menüpunkt
With .Controls.Add
.FaceId = 3
.Caption = strText(14)
.OnAction = "Modul_Funktion_Speichern.speichern_ohne_Makros"
End With
' Untermenü erzeugen:
' dritter Menüpunktmit Untermenü
With .Controls.Add(Type:=msoControlPopup)
' Trennlinie
.BeginGroup = True
.Caption = strText(15)
With .Controls.Add
.FaceId = 612
.Caption = strText(30)
.OnAction = "Modul_Funktion_Symbol.löschen_menü_starten"
End With
With .Controls.Add
.FaceId = 47
.Caption = strText(16)
.OnAction = "Modul_Funktion_Del.Layout_delete"
End With
With .Controls.Add
.FaceId = 47
.Caption = strText(35)
.OnAction = "Modul_Funktion_Symbol.tabellen_del_combobox"
End With
With .Controls.Add
.FaceId = 47
.Caption = strText(18)
.OnAction = "Modul_Funktion_Symbol.Header_löschen"
End With
With .Controls.Add
.FaceId = 47
.Caption = strText(19)
.OnAction = "Modul_Funktion_Symbol.Pad_löschen"
End With
With .Controls.Add
.FaceId = 47
.Caption = strText(20)
.OnAction = "Modul_Funktion_Symbol.Coor_löschen"
End With
With .Controls.Add
.FaceId = 47
.Caption = strText(21)
.OnAction = "Modul_Funktion_Del.alle_nicht_wichtigen"
End With
End With
With .Controls.Add(Type:=msoControlPopup)
' Trennlinie
.BeginGroup = True
.Caption = strText(27)
With .Controls.Add
.FaceId = 612
.Caption = strText(31)
.OnAction = "Modul_Funktion_Symbol.ExtraTools_menü_starten"
End With
With .Controls.Add
.FaceId = 675
.Caption = strText(7)
.OnAction = "Modul_Funktion_Symbol.IPSTD"
End With
With .Controls.Add
.FaceId = 675
.Caption = strText(28)
.OnAction = "Modul_Funktion_Symbol.TraceExtraTool"
End With
With .Controls.Add
.FaceId = 675
.Caption = strText(32)
.OnAction = "Modul_Funktion_Symbol.DesignAssi_starten"
End With
With .Controls.Add
.FaceId = 675
.Caption = strText(33)
.OnAction = "Modul_Funktion_DatenImport.Tabellen_kopieren"
End With
End With
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 20
.Caption = strText(22)
.OnAction = "Modul_Funktion_Symbol.option_öffnen"
End With '
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 59
.Caption = strText(26)
.OnAction = "Modul_Funktion_Diverse1.InfoShow"
End With
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 478
.Caption = strText(34)
.OnAction = "Modul_Funktion_Diverse1.Tool_close"
End With
End With
Gruß
Swen
End Sub