Microsoft Excel

Herbers Excel/VBA-Archiv

geht das auch kürzer ???

Betrifft: geht das auch kürzer ??? von: rolf
Geschrieben am: 15.08.2004 08:17:32

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

  


Betrifft: AW: geht das auch kürzer ??? von: andre
Geschrieben am: 15.08.2004 09:40:51

Hallo Rolf,
es geht, wenn Du mit Schleifen, Variablen und Arrays arbeitest. Hier mal ein Beispiel für das Anlegen:
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


Beim Löschen musst Du mal sehen, da kannst Du auch mit einer Schleife arbeiten.
Das laufende On Error GoTo 0 / On Error Resume Next ist übrigens auch Nonsens, Du hebst die Fehlerbehandlung auf und in der nächsten Zeile machst Du die Gleiche Fehlerbehandlung ...



  


Betrifft: AW: geht das auch kürzer ??? von: rolf
Geschrieben am: 15.08.2004 09:55:48

hallo andre

erstmal gruesse nach gera

danke für die antwort
ich versteh zwar im moment nur bahnhof aber ich versuch daraus schlau zu werden

gruss aus braunschweig
rolf


  


Betrifft: AW: geht das auch kürzer ??? von: andre
Geschrieben am: 15.08.2004 10:16:39

Hallo Rolf,
musst dich mal durch die Sache mit den Arrays durchlesen ...
Im Beispiel lege ich nur einen Button an, Du musst das dann entsprechend den Kommentaren erweitern.
Statt ("a", "b", "c", "d", "e", "f") musst Du natürlich Deine Daten nehmen - siehe wie ich es bei button1 geschrieben habe und dasselbe für die anderen.
Grüße, Andre


  


Betrifft: AW: geht das auch kürzer ??? von: rolf
Geschrieben am: 15.08.2004 10:19:46

hi andre

bin schon dabei, aber .....

aller anfang ist schwer

rolf


  


Betrifft: AW: geht das auch kürzer ??? von: rolf
Geschrieben am: 15.08.2004 16:33:51

hallo andre und andere

das makro bricht mit fehlercode 9
index außerhalb des gültigen bereich ab

gruss
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

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



  


Betrifft: AW: geht das auch kürzer ??? von: andre
Geschrieben am: 15.08.2004 17:40:36

Hallo rolf,
nimm mal bitte bei der Schleife nicht die Anzahl der Buttons, sondern die Anzahl-1, also ... to 4. Bei den Arrays kann man je nach Definition mit 0 oder 1 anfangen, in unserem Fall haben wir mit 0 angefangen ...
Grüße, Andre


  


Betrifft: AW: geht das auch kürzer ??? von: rolf
Geschrieben am: 15.08.2004 18:38:18

hallo andre

geändert. aber keine veränderung.

gibt es die möglichkeit, DIR die datei zu schicken ??
bist du der andre in den profilen ??

rolf


  


Betrifft: AW: geht das auch kürzer ??? von: andre
Geschrieben am: 15.08.2004 18:53:09

Hallo Rolf, mach mal, ich bin der.
Grüße, andre