Alle Shapes in der Tabelle markieren
13.03.2009 11:37:55
Stefan
ich programmiere gerade ein kleines Organigrammtool, das mit vorgefertigten Shapes (Wordart / Autoformen / Textfelder / Bildern) ein fertiges Organigramm erzeugt in einem eigenen Tabellenblatt.
Zuletzt möchte ich nun per VBA alle Shapes dieses Tabellenblattes markieren (und anschließend in die Zwischenablage kopieren).
Der Makrorecoder zeichnet zB solchen Code für das Markieren auf:
ActiveSheet.Shapes.Range(Array("AutoShape 242", "Group 243", "Group 246", "Group 249", "Picture 252", "Picture 253", "Picture 254", "Picture 255")).Select
Nun variieren natürlich die verwendeten Shapes und ich bräuchte ein Schleife durch alle Shapes, die alle auswählt.
Es ist ja recht einfach eine Schleife durch zB alle Bilder und Wordartobjekte zu bekommen - etwa um sie zu löschen
Sub ALLES_LOESCHEN
Dim BILD As Picture
Dim FORM As Shape
For Each BILD In ActiveSheet.Pictures ' Alle Bilder löschen
BILD.Delete
Next BILD
For Each FORM In ActiveSheet.Shapes ' Alle Wordart löschen
If WORDART.Type = msoTextEffect Then
FORM.Delete
End If
Next WORDART
End Sub
Ich schaffe es auch, einen String zu erzeugen, der genau die Liste der Shapes enthält:
Sub KOPIERE_DIAGRAMM()
Dim BILD As Picture
Dim FORM As Shape
Dim ALLES(1 To 14)
Dim ANZAHL As Integer
Dim GESAMT As String
For Each BILD In ActiveSheet.Pictures ' Alle Bilder
ANZAHL = ANZAHL + 1
ALLES(ANZAHL) = BILD.Name
Next BILD
For Each FORM In ActiveSheet.Shapes ' Alle übrigen Formen
ANZAHL = ANZAHL + 1
ALLES(ANZAHL) = Form.Name
Next FORM
For T = 1 To ANZAHL
GESAMT = GESAMT & """" & ALLES(T) & """" & ", "
Next T
GESAMT = Left(GESAMT, Len(GESAMT) - 2)
MsgBox GESAMT
ActiveSheet.Shapes.Range(Array(GESAMT)).Select
End Sub
Zuletzt enthält der String GESAMT genau die Form, die der eingangs erwähnte Macrorecorder-Befehl verwendet.
Leider finde ich keinen Weg diesen String in den obigen Befehl erfolgreich einzubauen.
Hat jemand eine Idee ?
Ich bin für jede Unterstützung dankbar und wünsche euch allen noch ein schönes Wochenende,
Stefan