Imágenes de orientación automática a través de VBA

¿Alguna vez ha cargado una imagen en un control de imagen de acceso, o control del navegador web ‘heredado’, solo para que la pantalla de imagen se voltee y/o gire como:

Cuando si lo abre en la mayoría del software de imagen, previsualice en Explorer, ábralo en la mayoría de los navegadores web modernos que se muestra bien como:

Y me pregunté qué estaba pasando exactamente.

Esto sucede debido a algo llamado la etiqueta de orientación exif, que es una pieza de metadatos almacenados dentro de muchas imágenes JPEG por cámaras.

Básicamente, cuando toma una foto, su cámara registra cómo sostenía el dispositivo (vertical, de lado, al revés, etc.) y guarda esta información en la etiqueta de orientación exif (esta es la información oculta que se almacena con la imagen). En lugar de girar los píxeles en el archivo de imagen, la cámara solo observa la orientación en los metadatos. Algunos programas, como Windows Explorer, leen esta etiqueta y muestran automáticamente la imagen en la orientación correcta. Otros programas pueden ignorar la etiqueta de orientación exif y mostrar la imagen a medida que se almacena físicamente, lo que puede dar como resultado que la imagen aparezca de lado o al revés

Resolviendo este problema

La única forma de garantizar el 100% de que la imagen se rinde correctamente es rotar y/o voltearlos a los valores de orientación exif especificados para restaurar la imagen a la orientación adecuada y guardarla como tal.

Entonces, eso es lo que me propuse hacer a través de la automatización, ¡así que ya no necesitaba remediar manualmente este problema cada vez que cargaba imágenes en acceso!

Como con la mayoría de las cosas hechas en VBA, hay una serie de posibles soluciones, en este artículo le mostraré 2.

Solución 1 – ImageMagick

Me encanta ImageMagick porque puede hacer casi todo a una imagen y, por lo general, todo lo que requiere es un solo comando para hacerlo.

Una vez más, no me decepcionaron e ImageMagick en realidad tiene la opción de línea de comandos -euto -orients solo para este propósito, lo que hace que sea súper fácil de realizar. Así que simplemente lo envolví en un procedimiento conveniente:

Function IM_ImageAutoOrient(ByVal sFile As String, _
                            ByVal sOutputFile As String) As String
' Rotate an image so that the EXIF orientation property is no longer required for proper display
    Dim sIMPath               As String
    Dim sCmd                  As String

    sIMPath = Application.CurrentProject.Path & "\ImageMagick\"
    '-auto-orient rotates the image so that the orientation property is set to 1, no longer needed
    '********** -strip removes exif info and especially any saved thumbnails **********
    sCmd = sIMPath & "magick """ & sFile & """ -auto-orient -strip """ & sOutputFile & """"
    Debug.Print sCmd
    Shell "cmd /c " & sCmd
End Function

Y ahora puedo arreglar la rotación de cualquier imagen simplemente haciendo:

IM_ImageAutoOrient "C:\Temp\OriginalImg.jpg", "C:\Temp\ProperlyOrientedImg.jpg"

Características del código

Este código

• requiere haber descargado la biblioteca ImageMagick
• es la aplicación independiente (debería funcionar en cualquier aplicación VBA: acceso, Excel, Outlook, PowerPoint, Word, …)

Solución 2 – WIA

Ahora, si no desea usar una biblioteca de terceros (aunque ImageMagick sea excepcional), no hay ningún problema, ya que podemos rectificar este problema usando WIA (adquisición de imágenes de Windows). Las cosas son un poco más complicadas, ¡pero ciertamente nada de lo que no podamos manejar!

Terminé creando un procedimiento como:

'---------------------------------------------------------------------------------------
' Procedure : WIA_AutoOrient
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Applies the Exif Orientation property to the image and saves it so it is
'             it properly oriented natively.
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: Late Binding version  -> None required
'             Early Binding version -> Microsoft Windows Image Acquisition Library vX.X
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile         : Fully qualified path and filename of the original image to re-orient
' sOutputFile   : Fully qualified path and filename of where to save the new image
'                   If omitted, overwrites the original file (sFile)
'
' Usage:
' ~~~~~~
' WIA_AutoOrient "C:\Temp\OriginalImg.jpg", "C:\Temp\ProperlyOrientedImg.jpg"
'   Returns ->
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2022-01-31              Initial Release
' 2         2025-05-26              Public Release
'---------------------------------------------------------------------------------------
Public Sub WIA_AutoOrient(sFile As String, _
                          Optional sOutputFile As String)
    On Error GoTo Error_Handler
    #Const WIA_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If WIA_EarlyBind = True Then
        Dim oIF               As WIA.ImageFile
        Dim oIP               As WIA.ImageProcess

        Set oIF = New WIA.ImageFile
        Set oIP = New WIA.ImageProcess
    #Else
        Dim oIF               As Object
        Dim oIP               As Object

        Set oIF = CreateObject("WIA.ImageFile")
        Set oIP = CreateObject("WIA.ImageProcess")
    #End If
    Dim lFilterCounter        As Long
    Dim bPropertyExists       As Boolean

    Set oIF = CreateObject("WIA.ImageFile")
    Set oIP = CreateObject("WIA.ImageProcess")

    ' Maybe add a check that the file exists?

    oIF.LoadFile (sFile)    ' Load  image to be able to work with it

    'Re-orient the image based on the current Orientation property value
    lFilterCounter = oIP.Filters.Count + 1
    If oIF.Properties.Exists("274") Then
        With oIP
            Select Case oIF.Properties("274").Value
                Case 2:
                    .Filters.Add .FilterInfos("RotateFlip").FilterID
                    .Filters(lFilterCounter).Properties("FlipHorizontal") = True
                Case 3:
                    .Filters.Add .FilterInfos("RotateFlip").FilterID
                    .Filters(lFilterCounter).Properties("RotationAngle") = 180
                Case 4:
                    .Filters.Add .FilterInfos("RotateFlip").FilterID
                    .Filters(lFilterCounter).Properties("FlipVertical") = True
                Case 5:
                    .Filters.Add .FilterInfos("RotateFlip").FilterID
                    .Filters(lFilterCounter).Properties("RotationAngle") = 90
                    .Filters(lFilterCounter).Properties("FlipHorizontal") = True
                Case 6:
                    .Filters.Add .FilterInfos("RotateFlip").FilterID
                    .Filters(lFilterCounter).Properties("RotationAngle") = 90
                Case 7:
                    .Filters.Add .FilterInfos("RotateFlip").FilterID
                    .Filters(lFilterCounter).Properties("RotationAngle") = 270
                    .Filters(lFilterCounter).Properties("FlipHorizontal") = True
                Case 8:
                    .Filters.Add .FilterInfos("RotateFlip").FilterID
                    .Filters(lFilterCounter).Properties("RotationAngle") = 270
            End Select
        End With
        bPropertyExists = True
    End If

    ' Reset the Orientation property value
    If bPropertyExists Then    'Update the Orientation property only if the property already existed
        lFilterCounter = oIP.Filters.Count + 1
        With oIP
            .Filters.Add (.FilterInfos("Exif").FilterID)
            .Filters(lFilterCounter).Properties("ID") = 274    ' Orientation property
            .Filters(lFilterCounter).Properties("Type") = 1003
            .Filters(lFilterCounter).Properties("Value") = 1    ' 1 => Normal orientation - possible values = 1-8

            Set oIF = .Apply(oIF)    ' Apply changes
        End With
    End If

    ' Save updated image to original path
    If sOutputFile = "" Then    'Overwrite original image
        Kill sFile    ' Delete original image so it can be overwritten
        oIF.SaveFile (sFile)
    Else    'Create new image
        oIF.SaveFile (sOutputFile)
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oIP = Nothing
    Set oIF = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: WIA_AutoOrient" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

donde podemos usarlo simplemente haciendo:

WIA_AutoOrient "C:\Temp\OriginalImg.jpg", "C:\Temp\ProperlyOrientedImg.jpg"

Características del código

Este código

• Se puede usar como enlace temprano o tardío, la elección es suya y se establece cambiando el valor de la constante WMI_EARLYBIND.
• ¿Es la arquitectura/bitness independiente (funciona en instalaciones de 32 y 64 bits)
• es la aplicación independiente (debería funcionar en cualquier aplicación VBA: acceso, Excel, Outlook, PowerPoint, Word, …)

¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡

Quería reconocer el hecho de que por simplicidad de las pruebas, utilicé imágenes con varios valores de orientación exif encontrados:

GitHub-Recurser/Exif-Orientation-Examples: imágenes de ejemplo para las diversas banderas de orientación exif, tanto en el paisaje como en la orientación del retrato.

Imágenes de ejemplo para las diversas banderas de orientación exif, tanto en paisaje como en la orientación del retrato. -recursos/exámenes de orientación exif

Historial de la página