code beschleunigen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: code beschleunigen
von: joe
Geschrieben am: 20.04.2005 14:12:53
hallo,
in meinem arbeitsblatt habe ich eine zeichnung per makro erstellt, in der sehr viele shapes enthalten sind.
alle shapes haben eine eindeutige bezeichnung.
in folgendem code-beispiel zähle ich zum einen die anzahl der vorhandenen shapes mit namen "Control" (einer xlCheckBox), und ändere dann die farbe von einem rechteck in abhägigkeit davon, ob "Control" true oder false ist.
leider dauert das bei großen zeichnungen zu lange.
daher würde es mich freuen, wenn jemand eine möglichkeit weiß, wie man dies beschleunigen könnte.


Sub zaehlen()
Dim auswahl As Shape
Dim rechteck As Shape
Dim zaehler As Integer
Dim rechteckzaehler As Integer
For Each auswahl In ActiveSheet.Shapes
   
        If (Left(auswahl.Name, 7) = "Control") Then
        zaehler = zaehler + 1
          auswahl.Select
                For Each rechteck In ActiveSheet.Shapes
                    If (rechteck.Name = "rechteck " & zaehler) Then
                        If (Selection.Value = 1) Then
                          rechteck.Fill.ForeColor.SchemeColor = 5
                          rechteck.AlternativeText = "auswahl"
                          rechteckzaehler = rechteckzaehler + 1
                        Else
                          rechteck.Fill.ForeColor.SchemeColor = 1
                          rechteck.AlternativeText = ""
                        End If
                    End If
                Next
        End If
Next
End Sub


vielen dank im voraus
joe
Bild

Betrifft: AW: code beschleunigen
von: Andre
Geschrieben am: 20.04.2005 14:18:14
Hast du schon mal versucht die Bildschirmausgabe dabei abzuschalten?
Bild

Betrifft: AW: code beschleunigen
von: joe
Geschrieben am: 20.04.2005 14:26:45
hallo andre,
ja, Application.ScreenUpdating = False habe ich schon getestet, und bringt auch was aber eben nicht genug.
andere idee?
joe
Bild

Betrifft: AW: code beschleunigen
von: Holger
Geschrieben am: 20.04.2005 14:33:42
Hi,
konsequent auf select verzichten!
mfg Holger
Bild

Betrifft: AW: code beschleunigen
von: joe
Geschrieben am: 20.04.2005 14:50:58
hallo holger,
danke, aber in diesem fall weiß ich nicht wie, weil "auswahl.value" nicht funktioniert hat - deshalb der umweg über select.
kannst du mir da weiterhelfen, weil das problem nicht zum ersten mal aufgetreten ist. das würde mich weiterbringen.
joe
Bild

Betrifft: AW: code beschleunigen
von: Holger
Geschrieben am: 20.04.2005 14:59:53
Hi,
lad mal ein kleines Beispiel hoch.
mfg Holger
Bild

Betrifft: AW: code beschleunigen
von: joe
Geschrieben am: 20.04.2005 15:32:18
hi holger,
wenn es geklappt hat, siehst du hier einen link mit dem gleichen beispiel wie beschrieben, allerdings nochmal gekürzt.
https://www.herber.de/bbs/user/21424.xls
es sind zwei funktionen drin - eine mit select, die andere ohne aber dafür mit einem debugfehler "objekt unterstützt diese eigenschaft oder methode nicht"
danke schon mal
joe
Bild

Betrifft: AW: code beschleunigen
von: Holger
Geschrieben am: 20.04.2005 15:47:47
Hi,
https://www.herber.de/bbs/user/21425.xls
mfg Holger
Bild

Betrifft: AW: code beschleunigen
von: joe
Geschrieben am: 20.04.2005 16:05:54
hallo holger,
einwandfrei - vielen dank für die hilfe - es funktioniert mit "control format".
danke dafür - leider hat sich an der geschwindigkeit nichts geändert.
das problem scheint daran zu liegen, dass ich zweimal mit der foreach - schleife sämtliche shapes des arbeitsblatts durchlaufe.
wenn ich den zweiten schleifendurchlauf umgehen könnte wäre es perfekt.
vielleicht dazu noch eine idee?
hier nochmal der code:

Sub zaehlen()
Dim auswahl As Shape
Dim rechteck As Shape
Dim zaehler As Integer
Dim rechteckzaehler As Integer
For Each auswahl In ActiveSheet.Shapes
   
        If (Left(auswahl.Name, 7) = "Control") Then
        zaehler = zaehler + 1
          auswahl.Select
                For Each rechteck In ActiveSheet.Shapes
                    If (rechteck.Name = "rechteck " & zaehler) Then
                        If (Selection.Value = 1) Then
                          rechteck.Fill.ForeColor.SchemeColor = 5
                          rechteck.AlternativeText = "auswahl"
                          rechteckzaehler = rechteckzaehler + 1
                        Else
                          rechteck.Fill.ForeColor.SchemeColor = 1
                          rechteck.AlternativeText = ""
                        End If
                    End If
                Next
        End If
Next
End Sub

mfg joe
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Combo Box Problem"