Anzeige
Archiv - Navigation
1012to1016
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
Inhaltsverzeichnis

Code verkürzen

Code verkürzen
07.10.2008 14:52:00
Frank
Hallo Excelfreaks!!!
Folgenden Code benutze ich um meine Optik aufzupeppen!

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
CommandButton001.Caption = Range("AQ3").Text
If CommandButton001.Caption = Range("AN1") Then
CommandButton001.BackColor = RGB(0, 0, 255)
Else
CommandButton001.BackColor = RGB(225, 225, 225)
End If
CommandButton002.Caption = Range("AQ4").Text
If CommandButton002.Caption = Range("AN1") Then
CommandButton002.BackColor = RGB(0, 0, 255)
Else
CommandButton002.BackColor = RGB(225, 225, 225)
End If
CommandButton003.Caption = Range("AQ5").Text
If CommandButton003.Caption = Range("AN1") Then
CommandButton003.BackColor = RGB(0, 0, 255)
Else
CommandButton003.BackColor = RGB(225, 225, 225)
End If
CommandButton004.Caption = Range("AQ6").Text
If CommandButton004.Caption = Range("AN1") Then
CommandButton004.BackColor = RGB(0, 0, 255)
Else
CommandButton004.BackColor = RGB(225, 225, 225)
End If
CommandButton005.Caption = Range("AQ7").Text
If CommandButton005.Caption = Range("AN1") Then
CommandButton005.BackColor = RGB(0, 0, 255)
Else
CommandButton005.BackColor = RGB(225, 225, 225)
End If
CommandButton006.Caption = Range("AQ8").Text
If CommandButton006.Caption = Range("AN1") Then
CommandButton006.BackColor = RGB(0, 0, 255)
Else
CommandButton006.BackColor = RGB(225, 225, 225)
End If
CommandButton007.Caption = Range("AQ9").Text
If CommandButton007.Caption = Range("AN1") Then
CommandButton007.BackColor = RGB(0, 0, 255)
Else
CommandButton007.BackColor = RGB(225, 225, 225)
End If
CommandButton008.Caption = Range("AQ10").Text
If CommandButton008.Caption = Range("AN1") Then
CommandButton008.BackColor = RGB(0, 0, 255)
Else
CommandButton008.BackColor = RGB(225, 225, 225)
End If
CommandButton009.Caption = Range("AQ11").Text
If CommandButton009.Caption = Range("AN1") Then
CommandButton009.BackColor = RGB(0, 0, 255)
Else
CommandButton009.BackColor = RGB(225, 225, 225)
End If
CommandButton010.Caption = Range("AQ12").Text
If CommandButton010.Caption = Range("AN1") Then
CommandButton010.BackColor = RGB(0, 0, 255)
Else
CommandButton010.BackColor = RGB(225, 225, 225)
End If
CommandButton011.Caption = Range("AQ13").Text
If CommandButton011.Caption = Range("AN1") Then
CommandButton011.BackColor = RGB(0, 0, 255)
Else
CommandButton011.BackColor = RGB(225, 225, 225)
End If
CommandButton012.Caption = Range("AQ14").Text
If CommandButton012.Caption = Range("AN1") Then
CommandButton012.BackColor = RGB(0, 0, 255)
Else
CommandButton012.BackColor = RGB(225, 225, 225)
End If
CommandButton013.Caption = Range("AQ15").Text
If CommandButton013.Caption = Range("AN1") Then
CommandButton013.BackColor = RGB(0, 0, 255)
Else
CommandButton013.BackColor = RGB(225, 225, 225)
End If
CommandButton014.Caption = Range("AQ16").Text
If CommandButton014.Caption = Range("AN1") Then
CommandButton014.BackColor = RGB(0, 0, 255)
Else
CommandButton014.BackColor = RGB(225, 225, 225)
End If
CommandButton015.Caption = Range("AQ17").Text
If CommandButton015.Caption = Range("AN1") Then
CommandButton015.BackColor = RGB(0, 0, 255)
Else
CommandButton015.BackColor = RGB(225, 225, 225)
End If
CommandButton016.Caption = Range("AQ18").Text
If CommandButton016.Caption = Range("AN1") Then
CommandButton016.BackColor = RGB(0, 0, 255)
Else
CommandButton016.BackColor = RGB(225, 225, 225)
End If
CommandButton017.Caption = Range("AQ19").Text
If CommandButton017.Caption = Range("AN1") Then
CommandButton017.BackColor = RGB(0, 0, 255)
Else
CommandButton017.BackColor = RGB(225, 225, 225)
End If
CommandButton018.Caption = Range("AQ20").Text
If CommandButton018.Caption = Range("AN1") Then
CommandButton018.BackColor = RGB(0, 0, 255)
Else
CommandButton018.BackColor = RGB(225, 225, 225)
End If
CommandButton019.Caption = Range("AQ21").Text
If CommandButton019.Caption = Range("AN1") Then
CommandButton019.BackColor = RGB(0, 0, 255)
Else
CommandButton019.BackColor = RGB(225, 225, 225)
End If
CommandButton020.Caption = Range("AQ22").Text
If CommandButton020.Caption = Range("AN1") Then
CommandButton020.BackColor = RGB(0, 0, 255)
Else
CommandButton020.BackColor = RGB(225, 225, 225)
End If
End Sub


Danach folgt CommandButton021 und Range beginnt wieder bei "AQ3" und das ganze soll sich dann fortlaufend bis zum CommandButton400 ziehen. Jedoch sagt mir eine Fehlermeldung "Prozedur zu lang". Wie kann ich die ganze Geschichte verkürzen und damit vereinfachen?
Wer kann helfenb? Vorab Danke!!!
Gruß Frank H.

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code verkürzen
07.10.2008 15:22:30
Tino
Hallo,
teste mal
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim A As Long

For A = 3 To 22
 With ActiveSheet.OLEObjects("CommandButton00" & A - 2).Object
      .Caption = Range("AQ" & A).Text
    If .Caption = Range("AN1") Then
       .BackColor = RGB(0, 0, 255)
    Else
       .BackColor = RGB(225, 225, 225)
    End If
 End With
Next A

End Sub


Gruß Tino

www.VBA-Excel.de


Anzeige
AW: Code verkürzen
07.10.2008 15:45:34
Reinhard
Hallo Tino,
ungetestet und mich gar nicht ins Thema vertieft denke ich, so sit das besser:
With ActiveSheet.OLEObjects("CommandButton" & Right("00" & A - 2, 3)).Object
Gruß
Reinhard
AW: Code verkürzen
07.10.2008 16:02:00
Tino
Hallo,
genau, sonst kommen ab der 10 falsche Namen raus.
Anstatt 010 wäre es bei mir 0010
Gut aufgepasst!
Gruß Tino
hier noch die Korrigierte Variante...
07.10.2008 17:43:00
Tino
Hallo,
..., sollte es Frank nicht schon selbst hinbekommen haben.
Microsoft Excel Objekt Tabelle1
Option Explicit 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
Dim A As Long 
 
For A = 3 To 22 
 With ActiveSheet.OLEObjects("CommandButton" & Format(A - 2, "000")).Object 
      .Caption = Range("AQ" & A).Text 
    If .Caption = Range("AN1") Then 
       .BackColor = RGB(0, 0, 255) 
    Else 
       .BackColor = RGB(225, 225, 225) 
    End If 
 End With 
Next A 
 
End Sub 


Gruß Tino

Anzeige
AW: hier noch die Korrigierte Variante...
08.10.2008 09:20:00
Frank
Hallo Tino!
Alles schön und gut, aber bei mir wird jede 22. Schaltfläche eingefärbt und nicht diese welche dem Wert aus AN1 entspricht, wo könnte der Fehler liegen! Danke!
Gruß Frank H.
AW: hier noch die Korrigierte Variante...
08.10.2008 10:17:22
Tino
Hallo,
hier der Code für 400 Button, eventuell überprüfe mal die Zuordnung Deiner Button zu den Zellen.
z. Bsp. muss Butten CommandButton381 zur Zelle AQ4 gehören
Modul Modul1
 
 
Option Explicit 
  
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
Dim A As Long 
Dim i As Integer 
Dim meButton As Integer 
 
For i = 1 To 20 
    For A = 3 To 22 
      meButton = meButton + 1 
     With ActiveSheet.OLEObjects("CommandButton" & Format(meButton, "000")).Object 
          .Caption = Range("AQ" & A).Text 
        If .Caption = Range("AN1") Then 
           .BackColor = RGB(0, 0, 255) 
        Else 
           .BackColor = RGB(225, 225, 225) 
        End If 
     End With 
    Next A 
Next i 
 
End Sub 


Gruß Tino

Anzeige
AW: Code verkürzen
07.10.2008 16:10:17
Chris
Servus,
so geht's auch:

Sub t()
Dim i As Long, x As Long, z As Long
x = 2
z = 21
For i = 1 To 400
OLEObjects("CommandButton" & i).Object.Caption = Range("AQ" & i + x + 21 - z)
If OLEObjects("CommandButton" & i).Object.Caption = Range("AN1") Then
OLEObjects("CommandButton" & i).Object.BackColor = RGB(0, 0, 255)
Else
OLEObjects("CommandButton" & i).Object.BackColor = RGB(225, 225, 255)
End If
If Not i / 21 Like "*,*" Then
x = 2
z = (i / 21 + 1) * 21
End If
Next i
End Sub


Makro in das entsprechende Tabellenmodul.
Gruß
Chris

Anzeige
AW: Sorry kleiner Fehler!
07.10.2008 16:11:34
Chris

Sub t()
Dim i As Long, x As Long, z As Long
x = 2
z = 21
For i = 1 To 400
OLEObjects("CommandButton00" & i).Object.Caption = Range("AQ" & i + x + 21 - z)
If OLEObjects("CommandButton00" & i).Object.Caption = Range("AN1") Then
OLEObjects("CommandButton00" & i).Object.BackColor = RGB(0, 0, 255)
Else
OLEObjects("CommandButton00" & i).Object.BackColor = RGB(225, 225, 255)
End If
If Not i / 21 Like "*,*" Then
x = 2
z = (i / 21 + 1) * 21
End If
Next i
End Sub


AW: Sorry kleiner Fehler!
07.10.2008 17:15:00
Frank
Hallo Zusammen!
Danke für die schnelle Hilfe! Leider funktionieren beide Makros nicht!
Wo kann der Fehler liegen oder was könnte ich falsch machen?
Gruß Frank H.
Anzeige
AW: Sorry kleiner Fehler!
07.10.2008 17:53:49
Reinhard
Hi Frank,
gib mal bitte genauere Info in welcher Codezeile ein Fehler angezeigt wird.
Nach sehr kurzer Überschau würde ich mal so blind tippen, ändere mal:
If Not i / 21 Like "*,*" Then
in
If Not i / 21 Like "*.*" Then
ist aber völlig ungetestet.
Gruß
Reinhard
AW: Sorry kleiner Fehler!
07.10.2008 21:33:38
Frank
Hallo Reinhard!
Er zeigt: Fehler beim Kompilieren: Sub oder Function nicht definiert. Nach der Zeile For wird OLEObjects blau hinterlegt. Klicke ich dann auf OK wird Sub t() gelb! Kannst du damit etwas anfangen?
Danke!
Gruß Frank H.
AW: Sorry kleiner Fehler!
08.10.2008 07:29:00
Reinhard
Hi Frank,
probier mal Activesheet.OLEObjects
Gruß
Reinhard
Anzeige
AW: Sorry kleiner Fehler!
08.10.2008 08:41:00
Chris
Servus,
muss wohl an der Anzahl der 00 liegen:

Sub tx()
Dim i As Long, x As Long, z As Long, NullAnz As String
x = 2
z = 21
For i = 1 To 400
If i 


Gruß
Chris

AW: Sorry kleiner Fehler!
08.10.2008 16:49:00
Frank
Hallo Chris!
Super Code! Musste nur aus ser 21 eine 20 machen und dann hat es geklappt, zumindest hat die ganze Sache den ersten Test bestanden. Bin nun auf die weiteren Tests gespannt!!!
Gruß Frank H.
AW: Code verkürzen
08.10.2008 01:26:03
Daniel
Hi
hier nochmal ein anderer Ansatz, um die IF-Abfragen zu vereinfachen:

Dim Farbe(1)
Farbe(1) = RGB(0, 0, 255)
Farbe(0) = RGB(255, 255, 255)
CommandButton001.Caption = Range("AQ3").Text
CommandButton001.Backcolor = Farbe(-(Range("AN1)=Range("AQ3")))
CommandButton002.Caption = Range("AQ4").Text
CommandButton002.Backcolor = Farbe(-(Range("AN1)=Range("AQ4")))


allerdings scheinen mir 400 Schaltflächen schon etwas gewagt.
da anzunehmen ist, daß du diese Schaltflächen im Qadrat angeordnet hast, stellt sich die Frage, ob sich das Problem ggf. nicht einfacher über normale Excelzellen lösen ließe.
Gruß, Daniel

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige