web-dev-qa-db-fra.com

Excel VBA Image EXIF ​​Orientation

Création de cette macro qui insère des images d’Active Directory dans une feuille de calcul Excel et la réduit pour s’adapter à la cellule. Cela fonctionne plutôt bien sauf pour les images provenant d’une source où leur orientation/rotation est définie dans les données EXIF. Alors dans: 

  • Dans l'Explorateur Windows - Pas de rotation 
  • Visionneuse d'images de fenêtre - Non pivoté
  • IE - Pas de rotation
  • Chrome - Roté
  • Excel - tourné

Tout cela est dû à un problème hérité de l'appareil photo à partir duquel l'image a été prise. Quelqu'un a posté un problème similaire mais il a été étiqueté comme un doublon, à tort, et a été ignoré depuis. J'ai trouvé ce obscure post si quelqu'un avait lié une classe de lecteurs exif, je l'ai testée et elle m'a donné la même valeur Orientation pour toutes mes images. 

The Problems: la photo est correctement tournée (YAY!), Mais position correspond à 35-80 colonnes à droite (Boo!) Et/ou 200 lignes vers le bas, et la mise à l'échelle est désactivée car elle mélange les champs width et height (Boo! x2).

Voici mon code:

For Each oCell In oRange
        If Dir(sLocT & oCell.Text) <> "" And oCell.Value <> "" Then
        'Width and Height set to -1 to preserve original dimensions.
            Set oPicture = oSheet.Shapes.AddPicture(Filename:=sLocT & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left + 10, Top:=oCell.Top + 10, Width:=-1, Height:=-1)

            oPicture.LockAspectRatio = True

        'Scales it down  
            oPicture.Height = 200
        'Adds a Nice margin in the cell, useless             
            oCell.RowHeight = oPicture.Height + 20
            oCell.ColumnWidth = oPicture.Width / 4
        Else

            oCell.Offset(0, 1).Value = ""
        End If
        Next oCell

Les dimensions de l’image peuvent être variables à partir de sources inconnues (mais je suis à peu près sûr que nous pouvons en accuser Samsung). Vous recherchez une solution et/ou une explication sans avoir besoin d'une application tierce.

Voici un échantillon des images pour essayer, la première image fonctionne correctement, les autres pas. 

excelvbaimageexcel-vbaimage-scaling
12
Martin Sing

Vous devez vérifier la rotation pour voir si vous devez ajuster la hauteur ou la largeur (en haut ou à gauche)

Ajustez votre boucle comme suit:

For Each oCell In oRange
        If Dir(sloct & oCell.Text) <> "" And oCell.Value <> "" Then
          Set oPicture = osheet.Shapes.AddPicture(Filename:=sloct & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left + 10, Top:=oCell.Top + 10, Width:=-1, Height:=-1)

          With oPicture
                .LockAspectRatio = True
            If .Rotation = 0 Or .Rotation = 180 Then
                .Height = 200
                 oCell.RowHeight = .Height + 20
                 oCell.ColumnWidth = .Width / 4
                .Top = oCell.Top
                .Left = oCell.Left
            Else
                .Width = 200
                oCell.RowHeight = .Width + 20
                oCell.ColumnWidth = .Height / 4
                .Top = oCell.Top + ((.Width - .Height) / 2)
                .Left = oCell.Left - ((.Width - .Height) / 2)
            End If

           End With
        Else
            oCell.Offset(0, 1).Value = ""
        End If
        Next oCell
2
EvR