Funktioniert prima bis auf die .jpg's.
Bei manchen .jpg's erkennt er das Format und alles funktioniert richtig, -aber bei manchen .jpg's bringt er die Fehlermeldung der MSgbox "Sie haben kein gültiges Bild ausgewählt!"
Das Ganze unabhängig von der Größe der Bilder, und auch unabhängig an welchem Rechner ich arbeite.
Ich kann mir das nicht erklären, denn in den Eigenschaften der Bilder steht in beiden Fällen ganz eindeutig: JPG-Datei (.JPG) und alle sind für den Vollzugriff zugelassen. Auch sonst kann ich an den Eigenschaften der Bilder kein Unterschied feststellen.
Kann mir da jemand helfen?
Vielen Dank schon mal vorab. Kalle
Der Code lautet:
Bild_Einfügen()
Dim Datei As Variant, Filter As String, Teil() As String
Dim Zelle As Range, i As Integer
Dim ScaleA As Double
On Error Resume Next
Set Zelle = Application.InputBox(Prompt:="Bitte Zielzelle wählen!", _
Default:=Cells(Rows.Count, "C").End(xlUp).Offset(1, -1).Address, Type:=8)
If Zelle Is Nothing Then Exit Sub
Filter = "Alle (*.bmp;*.gif;*.jpg;*.JPEG;*.png;*.tif), *.*,BitMaps (*.bmp),*.bmp,GIFs (*.gif),*.gif,JPGs (*.jpg),*.jpg,PNGs (*.png),*.png,TIFs (*.tif), *.tif"
ChDir ActiveWorkbook.Path & "\Bilder" '"\Bilder"
ChDir ActiveWorkbook.Path & "\Bilder" '"\Bildarchiv"
Datei = Application.GetOpenFilename(Filter, 1, "Bild auswählen", , True)
For i = 1 To UBound(Datei)
Select Case Right(Datei(i), 3)
Case "bmp", "jpg", "tif", "gif", "png"
ActiveSheet.Pictures.Insert(Datei(i)).Select
With Selection.ShapeRange
ScaleA = WorksheetFunction.Min(Zelle.Offset(i - 1, 0).Width / .Width, Zelle.Offset(i - 1, 0).Height / .Height)
.Height = .Height * ScaleA
.Top = Zelle.Offset(i - 1, 0).Top
.Left = Zelle.Offset(i - 1, 0).Left
End With
Selection.Placement = xlMoveAndSize
Selection.PrintObject = True
Teil = Split(Datei(i), "\")
Teil = Split(Teil(UBound(Teil)), ".")
Zelle.Offset(i - 1, 1).Value = "Bild: " & Teil(0)
Case Else
MSgbox "Sie haben kein gültiges Bild ausgewählt!", vbOKOnly Or vbCritical, "Bild einfügen """""
End Select
Next i
End Sub