Hi VBA Cracks,
ich habe via VBA am Bildschirm 10x10 Grafiken/Kreise (Shapes) erstellt, insgesamt also 100 Kreise am Bildschirm.
Jeder Kreis hat auch einen eigenen Namen (mit shape.name).
Der erste Kreis links oben hat dabei den Namen „01 01“ der 2. Kreis in der Reihe „01 02“ und der letzte Kreis, rechts unten „10 10“.
Somit hab ich eine art x-y Bezug zu jedem Kreis.
Jetzt werden willkürlich Kreise gelöscht, ganz normal über Kreis anklicken und „Entf“ Taste drücken.
Ich möchte nun anschlißend via VBA ZÜGIG rausfinden welche Kreise sind noch am Bildschirm? Ich denke dabei an ein 2-dimensionales Array wo mal eine „1“ reingeschrieben wird (quasi an der x-y-Pos.) falls der Kreis vorhanden ist oder eine „0“ falls Kreis fehlt.
ICH HABE HIER MEHRMALS GEHÖRT DIE „SELECT FUNKTION“ SOLL MAN STETS VERMEIDEN WEGN LAHMER GESCHWINDIGKEIT… ICH KONMME HIER ABER NUR MIT EINEM SELECT TEST WEITER?
ICH HABE HIER MEHRMALS GEHÖRT DIE „SELECT FUNKTION“ SOLL MAN
STETS VERMEIDEN WEGN LAHMER GESCHWINDIGKEIT… ICH KONMME HIER
ABER NUR MIT EINEM SELECT TEST WEITER?
Hallo Lombe,
anstatt hier rumzuschreien zeige mal lieber den Code damit man sieht warum du da Select benutzen mußt, ich sehe da erstmal keinerlei Grund dafür.
Und daß man Select/Active zu 99% nicht braucht hörste in allen Excelforen denn es ist so.
Nicht nur weil das den Code langsam macht, es macht den Code sehr bedeutend schlechter lesbar.
Hallo Reinhard,
hier sind beide codes (Kreise verlegen am Bildschirm
und der 2. code mit dem Test welche Kreise noch vorhanden sind.
Der 1.code geht soweit.
Im 2. Code mach ich alles falsch… benutzte Select und
auch noch ein „Goto“ mit Sprungmarke der nicht funktioniert.
Zudem wird die Sprungmarke immer angesprungen…
(Select und Goto = schlechten Ruf)
Option Explicit
Private Sub Kreise_setzen()
Dim X As Byte
Dim Y As Byte
Dim x_abstand As Integer
Dim y_abstand As Integer
x_abstand = 300 'Bezugspunkt am Bildschirm für den 1. Kreis links oben
y_abstand = 150 'Bezugspunkt am Bildschirm für den 1. Kreis links oben
Worksheets(3).Shapes(„Grafik2“).Copy '„Grafik2“ = Das ist der Kreis der als Vorlage in der 3. Mappe (Worksheets3) befindet
For Y = 1 To 10
For X = 1 To 10
Worksheets(1).Paste
Selection.Top = y_abstand
Selection.Left = x_abstand
Selection.Name = Right(Y + 100, 2) & " " & Right(100 + X, 2) 'Hier wird dem Kreis einem Namen vergeben als (x-y Position)
x_abstand = x_abstand + 80 '80 Punkte versetzt (nach rechts) wird der nächste Kreis gesetzt
Next X
y_abstand = y_abstand + 80 '80 Punkte versetzt (nach unten) wird der nächste Kreis gesetzt
x_abstand = 300 'damit beginnt der 1. Kreis der nächsten Zeile wieder linksbündig
Next Y
End Sub
Private Sub Teste_welche_Kreise_noch_vorhanden()
Dim X As Byte
Dim Y As Byte
Dim Matrix(1 To 10, 1 To 10) As Byte
Dim Kreis_Name As String
For Y = 1 To 10
For X = 1 To 10
Kreis_Name = Right(Y + 100, 2) & " " & Right(100 + X, 2)
ActiveSheet.Shapes(Kreis_Name).Select 'Hier wird versucht den Kreis zu selektieren, falls keiner da ist soll in die Matrix eine „0“
On Error GoTo Fehler:
hier sind beide codes (Kreise verlegen am Bildschirm
und der 2. code mit dem Test welche Kreise noch vorhanden
sind.
Hallo Lombe,
Option Explicit
Private Sub Kreise\_setzen()
Dim X As Byte, Y As Byte, x\_abstand As Integer, y\_abstand As Integer
x\_abstand = 300 'Bezugspunkt am Bildschirm für den 1. Kreis links oben
y\_abstand = 150 'Bezugspunkt am Bildschirm für den 1. Kreis links oben
'"Grafik2" = Das ist der Kreis der als Vorlage in der 3. Mappe (Worksheets3) befindet
Worksheets(3).Shapes("Grafik2").Copy
For Y = 1 To 10
For X = 1 To 10
Worksheets(1).Paste
Selection.Top = y\_abstand
Selection.Left = x\_abstand
'Hier wird dem Kreis einem Namen vergeben als (x-y Position)
'80 Punkte versetzt (nach rechts) wird der nächste Kreis gesetzt
Selection.Name = Right(Y + 100, 2) & " " & Right(100 + X, 2)
x\_abstand = x\_abstand + 80
Next X
'80 Punkte versetzt (nach unten) wird der nächste Kreis gesetzt
y\_abstand = y\_abstand + 80
'damit beginnt der 1. Kreis der nächsten Zeile wieder linksbündig
x\_abstand = 300
Next Y
End Sub
Private Sub Teste\_welche\_Kreise\_noch\_vorhanden()
Dim Matrix(1 To 10, 1 To 10) As Byte, Sh As Shape
For Each Sh In Worksheets(1).Shapes
If Mid(Sh.Name, 3, 1) = " " Then
Matrix(Split(Sh.Name)(0), Split(Sh.Name)(1)) = 1
End If
Next Sh
'weiterer Code um Matrix auszuwerten o.ä.
End Sub
auch noch ein „Goto“ mit Sprungmarke der nicht funktioniert.
Zudem wird die Sprungmarke immer angesprungen…
Die Anweisung ‚On Error Goto Sprungmarke‘ ist definitiv legitim. Du hast sie nur an der falschen Stelle geschrieben. Diese Anweisung sollte immer am Anfang einer Prozedur stehen, weil immer erst nach dieser Anweisung „auf Fehler reagiert“ wird. Scheinbar möchtest Du aber in Deinem Code mit dem ‚Select‘ absichtlich einen Fehler mit auslösen, aber zu diesem Zeitpunkt würde noch gar nicht auf Fehler reagiert werden.
Hallo Reinhard,
danke für die Lösung! Den „Each-Befehl“ hab ich schon öfters hier gesehen, lern ihn aber erst beim nächsten VBA-Aufbaukurs näher kennen, daher.
War klar dass mein Select-GoTo-Code totaler Käse war. Im weiteren Schritt kann ich nun die Matrix super auswerten für weitere Schritte.