Bild in Imagebox einbetten und anpassen
07.01.2020 09:37:03
Vitali
folgende Aufgabenstellung.
Ich möchte folgenden Code so umändern, dass die ausgewählten Bilder nicht in Aktive Zellen eingefügt werden sondern in die Image Boxen, wie auf dem Bild.
Die Größe der Bilder soll sich der Größe der Image Box anpassen.
Die Anzahl der Bilder soll sich auf die Anzahl der Image Boxen beschränken.
Sub InsertPictures()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
xRowIndex = Application.ActiveCell.Row
For lLoop = LBound(PicList) To UBound(PicList)
Set Rng = Cells(xRowIndex, xColIndex)
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, _
Rng.Top, Rng.Width, Rng.Height)
xRowIndex = xRowIndex + 1
Next
End If
End Sub
nur ich bin leider noch nicht so weit :) deshalb fände ich es cool wenn mal einer helfen könnte.
Bedanke mich im Voraus