UF Bildvorschau EXIF Daten Funktion
11.01.2024 07:06:03
Stefan
ich habe eine Frage, hinsichtlich einer Funktion in einem Userform. Habe ein größeres UF, in dem in einer Combobox ein Verzeichnis mit Bildern befüllt wurde. Durch das "Durchklicken" soll ein nebenstehendes Vorschaubild eingeblendet werden. Soweit so gut. Es ergibt sich aber durch die neuen Handys und EXIF Daten das Problem, dass die Orientierung nicht immer auf 1 steht, so dass teilweise die Bilder in der Explorer-Vorschau zb. in einer möglichen Variante um 90-Grad verdreht dargestellt werden, in der Ansicht des UF aber richtig. Dh, die Ansicht im Explorer und im UF unterscheiden sich immer wieder mal, je nachdem in welchem Modus das Bild auf dem Handy aufgenommen wurde. Windows interpretiert das aber offensichtlich richtig im Explorer, das VBA aber offensichtlich nicht.
Also war mein Ansatz die EXIF Daten eines Bildes vor dem Anzeigen auszulesen und diese dann in der Datei zu bereinigen, so dass immer die Orientierung 1 hinterlegt wird.
Demnach war mein Ansatz folgender:
Private Sub Eintrag_Listbox1_initialisieren()
Dim Img As WIA.ImageFile
Dim strFilePath As String
strFilePath = ListBox1.List(ListBox1.ListIndex, 1)
'Bild muss auf Orietierung 1 in den Exif-Files gestellt werden, da es sonst zu verdrehten Bildern kommt
Set Img = CheckExifOrientation(strFilePath)
'Miniaturvorschau im UF dann erst anzeigen
Image1.Picture = LoadPicture(strFilePath)
End Sub
und die Funktion dazu:
Public Function CheckExifOrientation(filePath As String) As Object
Dim oWIA As Object
Dim oIP As Object
Dim Img As WIA.ImageFile
Set oWIA = CreateObject("WIA.ImageFile")
oWIA.LoadFile filePath
Set CheckExifOrientation = oWIA
Set oIP = CreateObject("WIA.ImageProcess")
With oIP
If oWIA.Properties.Exists("274") Then
If oWIA.Properties("274").Value = 1 Then
Exit Function
Else
.Filters.Add (.FilterInfos("Exif").FilterID)
.Filters(1).Properties("ID") = 274
.Filters(1).Properties("Type") = 1003
.Filters(1).Properties("Value") = 1
End If
Else
Exit Function
End If
End With
Set oWIA = oIP.Apply(oWIA)
If filePath > "" Then
If filePath = filePath And Dir(filePath) > "" Then Kill (filePath)
oWIA.SaveFile filePath
End If
Set CheckExifOrientation = oWIA
End Function
Vl nicht sie saubere Lösung, mir viel aber nichts besseres dazu ein. Das klappte auch solange, bis jemand das Bild noch parallel dazu im Explorer öffnete und dort mit den Drehfunktionen spielte. Dann kam es zu Zugriffsfehlern auf die Datei. Insb. stürzte das UF dann in diesem Bereich ab und löschte die Datei sogar:
If filePath > "" Then
If filePath = filePath And Dir(filePath) > "" Then Kill (filePath)
oWIA.SaveFile filePath
End If
Meine Frage nun: Wie kann ich das vl sauberer lösen? Wie kann ich verhindern, dass es zu Fehlern kommt, wenn jemand die Datei parallel geöffnet hat. Zb dass das Bild dann einfach ignoriert wird, solange ein externern Zugriff über Explorer oder ein Bildbearbeitungsprogramm erfolgt.
Ich möchte also folgendes erreichen:
- In Explorer und VBA soll das Bild spiegelbildlich in gleicher Orientierung dargestellt werden, da ich auch in dem UF eine Rotationsmöglichkeit eingebaut habe. Dazu war der Gedanke, dass man die EXIF Orientierung auf 1 setzt. Dazu muss das Bild danach aber "gespeichert werden", zum die EXIF Daten.
- Wenn ein zugriff außerhalb des UF parallel erfolgt soll es nicht mehr zu Dateizugriffsfehlern kommen. GGF ein Hinweis, dass das Bild extern geöffnet ist und nicht angezeigt werden kann?
Ich hoffe, dass es einigermaßen verständlich war, was mein Vorhaben ist.
Lieben Dank für Eure Hilfe.
Stef