Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1208to1212
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

Prüfen welche Grafiken noch nicht gelöscht

Prüfen welche Grafiken noch nicht gelöscht
Lombe
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 komme hier nur mit einem Test mittels einer Select-Funktion weiter,
was weder funktioniert noch brauchbar scheint
Option Explicit
--------------------------------------------------
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:
Matrix(X, Y) = 1
Fehler:
Matrix(X, Y) = 0
Next X
Next Y
End Sub

Danke für jegliche Information.
Lombe

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Prüfen welche Grafiken noch nicht gelöscht
19.04.2011 10:34:11
ohne
Hallo,
Private Sub Teste_welche_Kreise_noch_vorhanden()
Dim Matrix(1 To 10, 1 To 10) As Byte
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
Matrix(CByte(Left(sh.Name, 2)), CByte(Right(sh.Name, 2))) = 1
Next sh
End Sub

das knirscht aber ...
19.04.2011 10:50:55
Rudi
Hallo,
wenn es noch andere Shapes gibt.
Gruß
Rudi
z.T. entknirscht...
19.04.2011 11:21:37
ohne

Private Sub Teste_welche_Kreise_noch_vorhanden()
Dim Matrix(1 To 10, 1 To 10) As Byte
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.AutoShapeType = msoShapeOval And _
Val(Left(sh.Name, 2)) > 0 And Val(Right(sh.Name, 2)) > 0 Then _
Matrix(CByte(Left(sh.Name, 2)), CByte(Right(sh.Name, 2))) = 1
Next sh
End Sub

Anzeige
jetzt dann doch mit wenn ;-) owT
19.04.2011 11:40:05
Rudi
AW: Prüfen welche Grafiken noch nicht gelöscht
19.04.2011 10:37:25
Rudi
Hallo,
so:
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
Dim shp As Shape
For X = 1 To 10
For Y = 1 To 10
Kreis_Name = Format(X, "00") & " " & Format(Y, "00")
On Error Resume Next
Set shp = ActiveSheet.Shapes(Kreis_Name)
On Error GoTo 0
If shp Is Nothing Then
Matrix(X, Y) = 0
Else
Matrix(X, Y) = 1
End If
Set shp = Nothing
Next Y
Next X
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige