Public Sub Bild_laden(WS As Worksheet, rng As Range, Pfad As String)
Dim Picture As Object
Application.ScreenUpdating = False
Set Picture = WS.Pictures.Insert(Pfad)
With Picture
.Top = rng.Top
.Left = rng.Left
End With
Application.ScreenUpdating = True
Call Maß(Picture, 200)
End Sub
Public Function Bild_auswahl() As String
Dim oFileDialog As FileDialog
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With oFileDialog
.Filters.Clear
.Filters.Add "Bilddateien", "*.jpg", 1
.Filters.Add "Bilddateien", "*.tif", 2
.Filters.Add "Bilddateien", "*.gif", 3
.Filters.Add "Bilddateien", "*.bmp", 4
.Filters.Add "Bilddateien", "*.png", 5
.Title = "Bitte wählen Sie ein Bild aus"
.ButtonName = "wählen"
.AllowMultiSelect = False
If .Show = -1 Then Bild_auswahl = .SelectedItems(1)
End With
End Function
Public Function Datei_vorhanden(Pfad As String) As Boolean
If Dir(Pfad, vbDirectory) = "" Then
Datei_vorhanden = False
Else
Datei_vorhanden = True
End If
End Function
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