Bild aus der Zelle ansprechen in VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo klexy,
hier mal das Grundgerüst für so eine Verschiebe-Aktion.
In dem Beispiel werden die Bilder im aktiven Blatt im Bereich B1:B100 gesucht und nach Tabelle2 in die Spalte C verschoben.
Gruß
Franz

Sub ShapesMove()
Dim objBild As Shape, rngZelle As Range
Dim zeileZ As Long
zeileZ = 2
For Each rngZelle In ActiveSheet.Range("B1:B100")
Set objBild = GetShapeinZelle(Zelle:=rngZelle, bolMsg:=False)
If Not objBild Is Nothing Then
MsgBox "Shape-Name in " & rngZelle.Address(False, False, xlA1) & ": " _
& objBild.Name
'Bild Verschieben (Ausschneiden nd Einfügen)
objBild.Cut
With Worksheets("Tabelle2")
.Paste
.Shapes(.Shapes.Count).Top = .Cells(zeileZ, 3).Top + 2
.Shapes(.Shapes.Count).Left = .Cells(zeileZ, 3).Left + 2
zeileZ = zeileZ + 1
End With
End If
Next rngZelle
End Sub
Function GetShapeinZelle(Zelle As Range, Optional bolMsg As Boolean) As Shape
Dim objShape As Shape
For Each objShape In ActiveSheet.Shapes
If objShape.TopLeftCell.Address = Zelle.Address Then
Set GetShapeinZelle = objShape
Exit For
End If
Next
If GetShapeinZelle Is Nothing And bolMsg = True Then
MsgBox "Kein Bild (Shape) in Zelle """ & Zelle.Address(False, False, xlA1) _
& """ vorhanden", _
vbOKOnly, "Finde Shape"
End If
End Function

Hi zusammen,
Franz' Beispiel läuft natürlich bei der geschilderten Problemstellung völlig zufriedenstellend.
Als Fan von Dictionaries hat es mich gejuckt, das mal mit richtig vielen (naja) Daten zu testen, und dann is es natürlich geschickter, alle Shapes nur einmal einzulesen und ein Array zurückzugeben, das man in der aufrufenden Prozedur nach Gusto verwurschteln kann - ich schreibe die Ausgabe halt mal einfach weg.
Die Grafiken sind eine durch unsere "Blaue Nacht" angeregte Spielerei: mir gefällt das Moiré so gut (wenn es denn eines ist).
Die Datei: https://www.herber.de/bbs/user/105342.xlsm
Schöne Grüße,
Michael
P.S.: den Code, mit dem ich das Ding erzeugt habe, habe ich mal weggelassen, aber auf Nachfrage...
P.P.S.: Daß jeweils viele der Grafiken an "einer" Zelle kleben, ist nicht verwunderlich, denn die Shapes je eines Kreises werden immer an die gleiche Position geschrieben, nur die Winkel ändern sich.
Schön nachzuvollziehen ist das, wenn man den letzten Parameter (wierum) auf True setzt.

Beliebteste Forumthreads (12 Monate)

Bild aus der Zelle ansprechen in VBA

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bild aus der Zelle ansprechen in VBA

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

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread