JPEG/JPG Exif Oriëntatie

[alphamax]

Soms kan het voorkomen dat bij het invoegen van een JPEG/JPG-afbeelding, de afbeelding op zijn zij liggend of gespiegeld wordt afgebeeld.
Dit komt omdat sommige camera's een oriëntatiesensor hebben die kan registreren of de camera rechtop staat of op zijn zij ligt.
Bij het afdrukken wordt deze oriëntatie-informatie opgeslagen in het "Orientation"-veld van het "EXIF"-gegevensblok.

Veel Windows programma's zijn zo slim dat ze voor jou die oriëntatie corrigeren bij het bekijken.
Maar andere Windows programma's, zoals office zijn wat minder slim en corrigeren dat niet.

Daarom heb in onderstaande code geschreven om de oriëntatie van afbeeldingen aan te passen tijdens het inladen.

Zie bijlage voor excel- bestand met testafbeeldingen.

Zet alle bestanden samen in 1 map en klik op de button.

Option Explicit

Private Sub CommandButton1_Click()

    Dim aCell As Variant
    Dim aPicture As Variant
    Dim bUpRight As Boolean
    Dim dPictureDiagonal As Double
    Dim i As Long
    Dim j As Long
    Dim lOrientation As Long
    Dim lZoom As Long
    Dim oShape As Object
    Dim sPath As String

    Application.ScreenUpdating = False

    'Wanneer de zoom niet 100% is, dan past de afbeelding niet netjes in de cellen
    lZoom = ActiveWindow.Zoom
    ActiveWindow.Zoom = 100

    For Each oShape In Shapes
        If oShape.Type = msoPicture Then
            oShape.Delete
        End If
    Next

    For i = 1 To 16

        sPath = ThisWorkbook.Path & "\" & Cells(1 + i, 2)

        With CreateObject("WIA.ImageFile")
            .LoadFile sPath
            lOrientation = .Properties("Orientation") - 1
        End With

        Cells(i + 1, 3).Value = lOrientation + 1

        For j = 1 To 2

            With Cells(i + 1, j + 3)
                aCell = Array(.Left, .Top, .Width, .Height)
            End With

            With ActiveSheet.Shapes.AddPicture(sPath, False, True, 0, 0, -1, -1)
                .LockAspectRatio = msoTrue

                aPicture = Array(.Width, .Height)

                'wanneer een hoekpunt van de afbeelding voorbij 0,0 draait, gebeuren er onvoorspelbare maatafwijkingen
                dPictureDiagonal = Sqr(aPicture(0) ^ 2 + aPicture(1) ^ 2)
                .IncrementLeft (dPictureDiagonal - aPicture(0)) / 2 - 1
                .IncrementTop (dPictureDiagonal - aPicture(1)) / 2 - 1

                'roteren en spiegelen, orientatie - 1 = binaire waarde
                If (lOrientation And 4) Then
                    .IncrementRotation 90
                    .Flip msoFlipHorizontal
                End If
                If (lOrientation And 2) Then
                    .IncrementRotation 180
                End If
                If (lOrientation And 1) Then
                    .Flip msoFlipHorizontal
                End If

                'centreer de afbeelding in de cel en houd rekening met de rotatie
                bUpRight = lOrientation < 4
                If aPicture(1) * aCell(3 + bUpRight) < aPicture(0) * aCell(2 - bUpRight) Then
                    .Width = aCell(3 + bUpRight)
                Else
                    .Height = aCell(2 - bUpRight)
                End If

                .IncrementLeft aCell(0) + (aCell(2) - .Width) / 2 - .Left
                .IncrementTop aCell(1) + (aCell(3) - .Height) / 2 - .Top

            End With
        Next
    Next

    ActiveWindow.Zoom = lZoom

    Application.ScreenUpdating = True

End Sub

Gemaakt en getest met windows 10 en excel 2007

 

[snb]

Ik zie waar dit een gevolg van is...

In mijn Office 2010 tref ik geen "WIA.ImageFile" bibliotheek aan.


Niet essentieel, maar toch:

Sub M_snb()
   Sheet1.Pictures.Select
   Selection.Delete
End Sub

 

[alphamax]

Nieuwe code en bestand in bericht#1.

 

[alphamax]

WIA.ImageFile is onderdeel van Windows Image Acquisition.
Het is geen bibliotheek of referentie van office.
Windows Image Acquisition regelt alles wat te maken heeft met scanners en digitale camera's en andere beeldbewerking in windows.
Je moet wel heel veel moeite doen om bij een standaard installatie van windows dit niet te installeren.
De code van snb uit bericht#2 werkt te goed, deze verwijderd zelfs de button

 

[snb]

Een Activex-button krijgt heeft hier type 12 (shapes(1).type)
Een Picture heeft hier type 13 (shapes(2).type)

Shapes.count en pictures.count geven beide 2 als resultaat

Shapes.selectall: selekteert ActiveX-button én picture
Pictures.select: selekteert ActiveX-button én picture

Shapes en pictures in VBA zijn blijkbaar uitwisselbaar.