Public Sub Bilderauswahl()
Dim Var As Variant, icounter As Integer, z As Integer
Var = Application.GetOpenFilename("Bild-Datei (*.jpg),*.jpg,", MultiSelect:=True, Title:="Bilderauswahl", buttontext:="Einfügen")
On Error GoTo Ende
z = 2
Application.ScreenUpdating = False
For icounter = 1 To UBound(Var)
Call Bild_laden(ActiveSheet, Cells(z, 2), Var(icounter))
z = z + 20
Next icounter
Application.ScreenUpdating = True
Ende:
End Sub
Public Sub Bild_laden(WS As Worksheet, rng As Range, Pfad As Variant)
Dim Picture As Object
Set Picture = WS.Pictures.Insert(Pfad)
With Picture
.Name = rng.Address & "_" & .Name
.Left = rng.Left
.Top = rng.Top
Call Maß(Picture, 200)
End With
End Sub
Sub Maß(SH As Object, Optional Höhe As Double, Optional Breite As Double)
Dim V As Double
With SH
If .Height > .Width Then
V = .Height / .Width
If Höhe = 0 Then
.Width = Breite
.Height = Breite * V
Else
.Height = Höhe
.Width = Höhe / V
End If
Else
V = .Width / .Height
If Höhe = 0 Then
.Width = Breite
.Height = Breite / V
Else
.Height = Höhe
.Width = Höhe * V
End If
End If
End With
End Sub