geht das auch kürzer ???

hallo exelaner
kann man diesen code verkürzen, oder einfacher gestalten ??
rolf
' ANLEGEN DER KONTOLEISTE


Sub ANLEGENDERKONTOLEISTE()
Dim objBar As CommandBar
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Delete
On Error GoTo 0
Set objBar = Application.CommandBars.Add("KONTOLEISTE", msoBarTop, False, False)
With objBar
.Visible = True
.Protection = msoBarNoChangeDock + msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoResize
End With
End Sub

' ANLEGEN DER BUTTON IN DER KONTOLEISTE


Sub ANLEGENDERBUTTON()
Application.ScreenUpdating = False
Dim objBtn As CommandBarButton
' EINFÜGEN DES BUTTON " KONTOVORGABEN ÄNDERN "
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("KONTOVORGABEN ÄNDERN").Delete
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=1, temporary:=True)
If Err <> 0 Then
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=0, temporary:=True)
End If
On Error GoTo 0
With objBtn
.Caption = "KONTOVORGABEN ÄNDERN"
.OnAction = "VORGABENÄNDERN"
.BeginGroup = False
.TooltipText = "HIER KÖNNEN DIE KONTOVORGABEN GEÄNDERT WERDEN"
.Style = msoButtonIconAndCaption
.FaceId = 548
End With
' EINFÜGEN DES BUTTON " ZURÜCK ZUM KONTO "
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("ZURÜCK ZUM KONTO").Delete
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=2, temporary:=True)
If Err <> 0 Then
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=1, temporary:=True)
End If
On Error GoTo 0
With objBtn
.Caption = "ZURÜCK ZUM KONTO"
.OnAction = "ZURÜCKZUMKONTO"
.BeginGroup = True
.TooltipText = "ZURÜCK ZUR KONTOÜBERSICHT"
.Style = msoButtonIconAndCaption
.FaceId = 41
End With
' EINFÜGEN DES BUTTON " NEUES JAHR ANLEGEN "
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("NEUES JAHR ANLEGEN").Delete
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=3, temporary:=True)
If Err <> 0 Then
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=2, temporary:=True)
End If
On Error GoTo 0
With objBtn
.Caption = "NEUES JAHR ANLEGEN"
.OnAction = "NEUESJAHRANLEGEN"
.BeginGroup = True
.TooltipText = "BLATT FÜR NEUES JAHR ANLEGEN"
.Style = msoButtonIconAndCaption
.FaceId = 246
End With
' EINFÜGEN DES BUTTON " DRUCKEN DER DATEI "
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("DRUCKEN DER DATEI").Delete
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=4, temporary:=True)
If Err <> 0 Then
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=3, temporary:=True)
End If
On Error GoTo 0
With objBtn
.Caption = "DRUCKEN DER DATEI"
.OnAction = "DRUCKENDERDATEI"
.BeginGroup = True
.TooltipText = "AUSDRUCKEN DER DATEI"
.Style = msoButtonIconAndCaption
.FaceId = 4
End With
' EINFÜGEN DES BUTTON " PROGRAMM BEENDEN "
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("PROGRAMM BEENDEN").Delete
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=5, temporary:=True)
If Err <> 0 Then
Err.Clear
Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=4, temporary:=True)
End If
On Error GoTo 0
With objBtn
.Caption = "PROGRAMM BEENDEN"
.OnAction = "BEENDEN"
.BeginGroup = True
.TooltipText = "BEENDET DAS PROGRAMM"
.Style = msoButtonIconAndCaption
.FaceId = 840
End With
'DEAKTIVIEREN DER OPTIONEN
Application.CommandBars.DisableCustomize = True
Application.ScreenUpdating = True
End Sub

' LÖSCHEN


Sub DeleteControl()
Application.ScreenUpdating = False
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Delete
On Error GoTo 0
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("KONTOVORGABEN ÄNDERN").Delete
On Error GoTo 0
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("NEUES JAHR ANLEGEN").Delete
On Error GoTo 0
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("DRUCKEN DER DATEI").Delete
On Error GoTo 0
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("ZURÜCK ZUM KONTO").Delete
On Error GoTo 0
On Error Resume Next
Application.CommandBars("KONTOLEISTE").Controls("PROGRAMM BEENDEN").Delete
On Error GoTo 0
Application.CommandBars.DisableCustomize = False
Application.ScreenUpdating = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ANLEGENDERBUTTON() Application.ScreenUpdating = False Dim objBtn As CommandBarButton Dim button1(), button2(), button_all() ' ... und die anderen button-Variablen 'die Eigenschaften entsprechend als 1-dimensionales array anlegen button1 = Array("KONTOVORGABEN ÄNDERN", "VORGABENÄNDERN", False, "HIER KÖNNEN DIE KONTOVORGABEN GEÄNDERT WERDEN", msoButtonIconAndCaption, 548) button2 = Array("a", "b", "c", "d", "e", "f") 'button3=... usw ' zusammenfassen zu einem 2-d-array button_all = Array(button1, button2) ', button3, button4 usw. ' EINFÜGEN DES BUTTON " KONTOVORGABEN ÄNDERN " ' On Error Resume Next For i = 0 To 0 'to anzahl der buttons Application.CommandBars("KONTOLEISTE").Controls("KONTOVORGABEN ÄNDERN").Delete Err.Clear Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=i + 1, temporary:=True) If Err <> 0 Then Err.Clear Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=i, temporary:=True) End If On Error GoTo 0 With objBtn .Caption = button_all(i, 1) .OnAction = button_all(i, 2) .BeginGroup = button_all(i, 3) .TooltipText = button_all(i, 4) .Style = button_all(i, 5) .FaceId = button_all(i, 6) End With Next End Sub

Sub ANLEGENDERKONTOLEISTE() Dim objBar As CommandBar On Error Resume Next Application.CommandBars("KONTOLEISTE").Delete On Error GoTo 0 Set objBar = Application.CommandBars.Add("KONTOLEISTE", msoBarTop, False, False) With objBar .Visible = True .Protection = msoBarNoChangeDock + msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoResize End With End Sub

Sub ANLEGENDERBUTTON() Application.ScreenUpdating = False Dim objBtn As CommandBarButton Dim button1(), button2(), button3(), button4(), button5(), button_all() 'und die anderen button-Variablen 'die Eigenschaften entsprechend als 1-dimensionales array anlegen button1 = Array("KONTOVORGABEN ÄNDERN", "VORGABENÄNDERN", False, "HIER KÖNNEN DIE KONTOVORGABEN GEÄNDERT WERDEN", msoButtonIconAndCaption, 548) button2 = Array("ZURÜCK ZUM KONTO", "ZURÜCKZUMKONTO", False, "HIER GEHTS ZURÜCK ZU KONTO", msoButtonIconAndCaption, 41) button3 = Array("NEUES JAHR ANLEGEN", "NEUESJAHRANLEGEN", False, "HIER WIRD EIN NEUES JAHR ANGELEGT", msoButtonIconAndCaption, 246) button4 = Array("DRUCKEN DER DATEI", "DRUCKENDERDATEI", False, "HIER WIRD DAS AKTUELLE BLATT GEDRUCKT", msoButtonIconAndCaption, 4) button5 = Array("PROGRAMM BEENDEN", "BEENDEN", False, "HIER WIRD DAS PROGRAMM BEENDET", msoButtonIconAndCaption, 840) ' zusammenfassen zu einem 2-d-array button_all = Array(button1, button2, button3, button4, button5) ', button3, button4 usw. 'On Error Resume Next For i = 0 To 5 'to anzahl der buttons 'Application.CommandBars("KONTOLEISTE").Delete 'Err.Clear Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=i + 1, temporary:=True) If Err <> 0 Then Err.Clear Set objBtn = Application.CommandBars("KONTOLEISTE").Controls.Add(Type:=msoControlButton, Before:=i, temporary:=True) End If On Error GoTo 0 With objBtn .Caption = button_all(i, 1) ' HIER ENTSTEHT DER FEHLER .OnAction = button_all(i, 2) .BeginGroup = button_all(i, 3) .TooltipText = button_all(i, 4) .Style = button_all(i, 5) .FaceId = button_all(i, 6) End With Next Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread