Microsoft Excel

Herbers Excel/VBA-Archiv

einfügen von .jpg-Bildern geht nicht immer


Betrifft: einfügen von .jpg-Bildern geht nicht immer
von: Kalle Sz.
Geschrieben am: 05.12.2018 11:37:35

Habe mit toller Unterstützung von Karl-Heinz nachstehenden Code erstellt.
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

  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Gunter
Geschrieben am: 05.12.2018 11:57:51

Hallo Kalle
kannst du ein Bild das nicht funktioniert hochladen?

Gruss
GUnter


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Karl-Heinz Voltmann
Geschrieben am: 05.12.2018 12:45:15

Hallo Kalle,

wenn die MsgBox mit dem Text "Sie haben kein gültiges Bild ausgewählt!", kommt, wurde ggf. die Dateierweiterung nicht gefunden.

Lass Dir doch erst mal die wirkliche Erweiterung anzeigen, ich glaube, es gibt/gab auch *.jpeg":
 MSGBOX Right(Datei(i), 3)
 Select Case Right(Datei(i), 3)
 Case "bmp", "jpg", "tif", "gif", "png", "peg"

Sollte es dies sein, musst Du noch die Cases um "peg"
erweitern.

Wenn nicht, mal mit F8 Einzelschritt machen, um zu schauen, wie der Ablauf ist.

viele Grüße
Karl-Heinz


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Rudi Maintaire
Geschrieben am: 05.12.2018 12:36:46

Hallo,
das passiert wahrscheinlich, wenn du ein *.JPEG auswählst oder die Dateiendung groß geschrieben ist.

Ursache:

Select Case Right(Datei(i), 3)
Case "bmp", "jpg", "tif", "gif", "png"
Abhilfe:
Select Case LCase(Right(Datei(i), 4)
Case ".bmp", ".jpg", ".tif", ".gif", ".png", "jpeg"
Gruß
Rudi


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Karl-Heinz Voltmann
Geschrieben am: 05.12.2018 12:49:51

Hallo Kalle,

oder gleich Rudis Vorschlag nehmen.

Und:
ChDir ActiveWorkbook.Path & "\Bilder" '"\Bilder"
ChDir ActiveWorkbook.Path & "\Bilder" '"\Bildarchiv"
ist doppelt. Eins kann weg.

VG KH


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle Sz.
Geschrieben am: 05.12.2018 13:19:29

Hallo Rudis Vorschlag hatte ich schon probiert. Ging aber nicht. Wo ist der Unterschied?

Bei dieser Auswahl:
Case "bmp", "jpg", "jpeg", "tif", "gif", "PNG", "png", "JPEG"

Hier eines der Bilder das nicht geht.


Und hier ein Bild womit es funktioniert:




Hat jemand eine Idee?
Vielen Dank Kalle


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Gunter
Geschrieben am: 05.12.2018 13:37:01

Hallo Kalle
Kannst du ein Bild das nicht geht über den File Upload hochladen. Ich würde das gern mit diesem ausprobieren, da es bei mir bisher immer ohne Fehler funktioniert. Daher liegt der Verdacht nahe, dass es an den Bildern selber liegt!?

Gruss
Gunter


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle Sz.
Geschrieben am: 05.12.2018 13:43:35

Hallo Gunter, schon passiert, hab mal zwei Beispiele hochgeladen.


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle Sz.
Geschrieben am: 05.12.2018 13:37:37


Zur Sicherheit hier noch ein weiteres Beispiel.
Dieses Bild mit Auto funktioniert


und dieses mit den Blumen funktioniert nicht:


Wo liegt der Fehler??

Vielen Dank Kalle Sz.


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Gunter
Geschrieben am: 05.12.2018 14:04:07

Hallo Kalle
Deine Beispielbilder die bei dir nicht funktionieren, gehen bei mir.
Probier mal die nicht gehenden Bilder wieder runterzulanden und nochmals zu importieren.
Hast du vielleicht irgendwelche Sonderzeichen im Namen?
Gruss
Gunter


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle Sz.
Geschrieben am: 05.12.2018 14:16:26

Hallo Gunter

Ja nach dem wieder runterladen gehen sie auch bei mir. Die besagten Dateien haben keine Sonderzeichen, ich kann die nennen wie ich will. z:B: DSCN1265 mit der Endung .jpg Es geht einfach nicht.

Viele Grüße
Kalle Sz.


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Gunter
Geschrieben am: 05.12.2018 14:20:07

Hmmm, wie sieht es denn mit dem Pfadnamen aus, stammen die alle vom gleichen Speicherort?


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle Sz.
Geschrieben am: 05.12.2018 14:24:05

Ja definitiv alle aus dem gleichen Ordner.


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Gunter
Geschrieben am: 05.12.2018 14:27:39

Kennst du das Programm IrfanView?


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Gunter
Geschrieben am: 05.12.2018 14:27:40

Kennst du das Programm IrfanView?


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle
Geschrieben am: 05.12.2018 15:53:02

Ja, das hab ich bei der Arbeit, zuHause nicht.


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Karl-Heinz Voltmann
Geschrieben am: 05.12.2018 14:58:46

Also ich kann alle Bilder problemlos einfügen.
Allerdings denke ich, dass durch das Hoch- und Runterladen der Bilder vielleicht auch ein veränderter Zustand entstehen kann.

Bist Du denn jetzt mal im Einzelschrittmodus durchgegangen und hast Dir die Dateierweiterung der nicht funktionierenden Bilder ausgeben lassen. Die Meldung darf nur kommen, wenn diese nicht im select case gefunden wird.

Ansonsten nimm mal das "On error resume next" weg, falls irgendwie ein Fehler vorkommen sollte springt das Programm dann dahin.

VG KH


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle
Geschrieben am: 05.12.2018 15:55:37

Ich werde heute abend mal probieren.

Melde mich aber auf alle Fälle nochmals.


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: PeterK
Geschrieben am: 05.12.2018 16:08:56

Hallo

Da ja Deine Messagebox kommt, wird der Insert erst gar nicht probiert, d.h. Du hast kein Problem mit dem Bild als solches sondern mit dem Datei Namen/Typ (vieleicht ist es ein Link auf ein Bild). Ändere deine Warnmeldung in


 MsgBox "Sie haben kein gültiges Bild ausgewählt! " & Chr(10) & Datei(i), vbOKOnly Or  _
vbCritical, "Bild einfügen """""



  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle
Geschrieben am: 05.12.2018 16:54:03

Ich glaub ich hab`s. Bin ziemlich sicher!

Case "bmp", "jpg", "tif", "gif", "PNG", "png", "JPG", "jpeg", "JPEG"

Es fehlten die Endungen mit den Großbuchstaben.

Ich teste jetzt noch alle Formate. Und melde mich nochmals, falls das Problem docj nochmal auftaucht!

Vielen Dank Euch Allen. Ihr seid SUPER!

Herzliche Grüße Kalle Sz.


  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: PeterK
Geschrieben am: 05.12.2018 17:25:15

Hallo

Verwende "UCase" um alles in Großbuchstaben zu bekommen


Case Ucase(Right(Datei(i), 3))
  Case 'BMP", "JPG", "TIF", "GIF", "PNG", "PEG"



  

Betrifft: AW: einfügen von .jpg-Bildern geht nicht immer
von: Kalle
Geschrieben am: 05.12.2018 19:17:39

Hallo Peter,

aber dann holt er mir dann auch die Bilder, deren Endungen klein geschrieben sind. Mit UCase macjh ich doch alles in Großbuchstaben. Oder?

Ich hab jetzt mal sicherheitshalber alles eingegeben:
Case "bmp", "BMP", "jpg", "tif", "TIF", "gif", "GIF", "PNG", "png", "JPG", "jpeg", "JPEG"

Hatte seither beim durchtesten noch keinen Fehler!

Viele Grüße aus der Kurpfalz


  

Betrifft: das hatte ich schon ...
von: Rudi Maintaire
Geschrieben am: 06.12.2018 11:54:28

... sinngemäß in meinem ersten Beitrag geschrieben.


  

Betrifft: Nachfrage: ins vorgegebene Verzeichnis springen
von: Kalle Sz.
Geschrieben am: 06.12.2018 17:04:58

Hallo Rudi,
klar das war die Lösung, nur mit meinen geringen VB-Kenntnissen, dauerte das ein bissschen, bis ich es richtig verstand. Aber ich lerne ja daraus.
Deshalb nochmals an alle: Ein ganz großes Dankeschön für Eure Arbeit und Eure Hilfe!

Ich hätte da auch noch eine weitere Frage ans Forum:
Um den Ablauf des Codes zu verbessern, hätte ich gerne, dass zur Auswahl der Bilder direkt der richtige Ordner aufgeht, in dem auch die Bilder drin sind.
Das wäre in meinem Falle immer: ChDir ActiveWorkbook.Path & "\Bilder"

Das funktioniert aber erst beim zweiten Aufruf des Codes. Lösung ist bestimmt einfach, wenn man es weiß! Wie baue ich das in meinen Code ein?

Hier der Code, wie er bisher problemlos funktioniert:

Sub Bild_Einfügen()
    Dim Datei As Variant, Filter As String, Teil() As String
    Dim Zelle As Range, i As Integer
    Dim ScaleA As Double
    
    Call Bilder_Löschen
    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;*.png;*.tif;*.JPG;*.JPEG;*.jpeg), *.*,BitMaps (*.bmp),*. _
bmp,GIFs (*.gif),*.gif,JPegs (*.jpg),*.jpg,PNGs (*.png),*.jpg,TIFs (*.tif), *.tif"
    ChDir ActiveWorkbook.Path & "\Bilder"
    Datei = Application.GetOpenFilename(Filter, 1, "Bild auswählen", , True)
    For i = 1 To UBound(Datei)
     Select Case Right(Datei(i), 3)
       Case "bmp", "BMP", "jpg", "tif", "TIF", "gif", "GIF", "PNG", "png", "JPG", "jpeg", "JPEG" _

            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! " & Chr(10) & Datei(i), vbOKOnly Or _
vbCritical, "Bild einfügen """""
     End Select
    Next i
   End Sub