Office: (Office 2010) Makro Bild einfügen und an Zellbereich anpassen

Hallo Spezialistengemeinde,

Mein Datenblatt dient zur Erfassung mehrerer Produkte. Mit jeder neuen Artikelnummer soll auch ein Bild in der benachbarten Zelle eingefügt werden können. Aus Gründen habe ich mehrere Zellen verbunden, was also beispielsweise für das Bild den Bereich B8:B14 bedeutet.

Ich habe folgendes Makro, um das Fenster zum Bild einfügen zu öffnen:

Sub InsertPicture()
Dim sPicture As String, pic As Picture

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With

Set pic = Nothing

End Sub


Kann mir bitte jemand dabei helfen das Makro so umzuschreiben, dass das eingefügte Bild sich automatisch an den Zellenbereich B8:B14 anpasst?

Vielen Dank im Voraus
Björn

:)

 

Hallo Björn,

Meinst du so:

Code:

 

Super. Vielen Dank für die schnelle Hilfe. War ja einfacher, als gedacht...

 

Hallo
Ich hoffe ich darf mich hier kurz melden
Ich fand dieses Thema SEHR hilfreich. Doch ich habe auf meinem Surface Pro4 ein starkes Leistungsproblem... i glaube das liegt daran das die Bilder dan nur verlinkt sind und nicht eingebettet? Gibt es eine Möglichkeit das ich die Bilder einfüge und evetl. auch gleich skalieren (komprimieren)?
Ich mache für die Arbeit Fotodokumentationen und möchte daher das file möglichst klein behalten (auch wenn der PDF export sehr gut komprimiert).

Ich habe asl erleuterung eine Leere version angehängt.
Wir sind eine kleine Firma und daher suche ich hier Hilfe und bin für alle Tipps sehr dankbar.