Namen der Shapes auflisten

[LacTyyn]

Hallo Community,
ich bitte bei zwei Anliegen um eure Unterstützung. 

Zum einen habe ich probiert, mir ein kleines Makro zu schreiben, welches mir eine Liste aller Shapes mit dem Namen "Haus" erstellt. Das klappt auch soweit, allerdings enthält die Liste Leerzeilen für die Shapes, welche nicht "Haus" im Namen haben. Hier komme ich mit meinem Anfängerwissen gerade nicht weiter.

Die Liste soll ab der Zelle H2 im Arbeitsblatt "Grundriss" erstellt und durch den Button "Liste Häuser" gestartet werden.

Code:

Sub ListeShapes()
Dim iCount As Integer
Range("H2:j5000").Clear
For iCount = 1 To ActiveSheet.Shapes.Count
    If Left(ActiveSheet.Shapes(iCount).Name, 4) = "Haus" Then
    Cells(iCount + 1, 8).Value = ActiveSheet.Shapes(iCount).Name
    Else
    iCount = iCount + 1
    End If
Next iCount
End Sub

Zum anderen bin ich dabei mich in die VBA -Programmierung einzulesen bzw. mir diese anzueignen. Dazu habe ich mir eine kleine Aufgabe gestellt, welche ich Schritt für Schritt abarbeiten möchte. Das zuvor beschriebene Problem ist eine kleine Teilaufgabe.
Würdet ihr mir empfehlen, mir hierzu Fachliteratur zu besorgen, wenn ja welche würdet ihr empfehlen oder reicht das große weite Netz hierfür aus?

Danke und viele Grüße

[Kuwer]

Hallo,

lass das iCount = iCount + 1 weg, denn iCount zählt ja schon durch die Schleife hoch. Außerdem werden Shapes dadurch übersprungen.

Gruß Uwe

[LacTyyn]

Danke für deine Hilfe. Ich habe deinen Hinweis berücksichtigt. Er löst allerdings nicht mein Problem, dass die Liste weiterhin Leerzeilen enthält für die Shapes, welche nicht "Haus" im Namen haben.

[Ego]

Hallo L...,

nimm für die Schleife und für die Einträge verschiedene Zähler

Code:

Code:

Sub ListeShapes()
Dim iCount As Integer
Dim jCount As Integer
Range("H2:j5000").Clear
jCount = 1
For iCount = 1 To ActiveSheet.Shapes.Count
    If Left(ActiveSheet.Shapes(iCount).Name, 4) = "Haus" Then
        jCount = jCount + 1
        Cells(jCount, 8).Value = ActiveSheet.Shapes(iCount).Name
    End If
Next iCount
End Sub

nach dem Netz ist in Listen eine "For each"-Schleife schneller als eine Zählschleife:

Code:

Sub ListeShapes()
Dim shp As Shape
Dim jCount As Integer
Range("H2:j5000").Clear
jCount = 1
For Each shp in ActiveSheet.Shapes
    If Left(shp.Name, 4) = "Haus" Then
        jCount = jCount + 1
        Cells(jCount, 8).Value = shp.Name
    End If
Next shp
End Sub

[LacTyyn]

Vielen Dank für eure Hilfe. So funktioniert's.
Viele Grüße