Shapes in VBA ansprechen

Sub ShapesAnsprechen() counter = 0 For Each bilder In ActiveSheet.Shapes If bilder.Type = 17 Then ReDim Preserve alle_bilder(0 To counter) alle_bilder(counter) = bilder.Name counter = counter + 1 End If Next bilder ActiveSheet.Shapes.Range(alle_bilder).Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Felix,
du kannst die Shapes über den Namen ansprechen. Es geht aber auch über die Zelle in der sich die linke obere Ecke des Shapes befindet. In deinem Fall könntest du alle Shapes selektieren, die sich links von einer bestimmten Spalte befinden.


Sub ShapesAnsprechen()
Dim objShape As Shape
Dim alle_bilder(), counter As Integer
counter = 0
For Each objShape In ActiveSheet.Shapes
'        If Left(objShape.Name, 3)  "LX_" Then
If objShape.TopLeftCell.Column  0 Then
ActiveSheet.Shapes.Range(alle_bilder).Select
End If
End Sub

Das letzte eingefügte Shape kann man über die Index-Nummer ansprechen.

Sub ShapesAnsprechenLetztes()
Dim objShape As Shape
With ActiveSheet
Set objShape = .Shapes(.Shapes.Count)
End With
objShape.Select
End Sub

Falls du die nicht zu selektierenden Shapes über den Namen ausschliessen möchtest, dann solltest du eine "ungewöhnliche" Prefix verwenden. Auch für das Umbenennen hier ein makro.


Sub ShapesUmbenennen()
Dim objShape As Shape, strNeuername As String, Spalte As Long, PreFix As String
Spalte = 7 'Spalte G - Shapes rechts von dieser Spalte erhalten die PreFix
PreFix = "LX_" 'Zeichenfolge, die den Namen vorangestellt wird
For Each objShape In ActiveSheet.Shapes
With objShape
If .TopLeftCell.Column > Spalte Then
.Select
ActiveWindow.ScrollRow = .TopLeftCell.Row
ActiveWindow.ScrollColumn = .TopLeftCell.Column
strNeuername = InputBox("TopLeftcell: " & .TopLeftCell.Address & vbLf _
& "ID: " & .ID & vbLf & vbLf & "Neuer Name:", "Name: " & .Name, PreFix & .Name)
If strNeuername  "" Then
.Name = strNeuername
End If
End If
End With
Next
End Sub

Gruß
Franz

Sub Fertigstellen() Dim objShape As Shape Dim alle_bilder(), counter As Integer counter = 0 For Each objShape In ActiveSheet.Shapes If objShape.TopLeftCell.Column 0 Then ActiveSheet.Shapes.Range(alle_bilder).Select End If Selection.Copy Set doc = app.Documents.Add("C:\Users\Felix\Desktop\Prozesskette.docm") docname = ("Prozesskette.docm") app.Visible = True On Error Resume Next doc.Bookmarks("Hier").Select If Err.Number = 0 Then app.Selection.InsertAfter Selection End If Err.Clear End Sub

Sub Fertigstellen() Dim objShape As Shape Dim alle_bilder(), counter As Integer counter = 0 For Each objShape In ActiveSheet.Shapes If objShape.TopLeftCell.Column 0 Then ActiveSheet.Shapes.Range(alle_bilder).Select End If Selection.Copy Set doc = app.Documents.Add("C:\Users\Felix\Desktop\Prozesskette.docm") docname = ("Prozesskette.docm") app.Visible = True doc.Bookmarks("Hier").Select On Error Resume Next If Err.Number = 0 Then doc.Bookmarks("Hier").Range.PasteSpecial Link:=False, DataType:=23, Placement:=0, _ DisplayAsIcon:=False ' Placement:= 0 = wdInLine _ DataType:=23 = Microdsoft Grafik-Objekt - Einzelobjekte wie in Excel _ 9 = Bild wdPasteEnhancedMetafile _ 14 = einfügen als Bild _ 15 = einfügen als JPG-Bild End If Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

11 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Shapes in VBA ansprechen

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

11 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread