web-dev-qa-db-de.com

Excel VBA-Bild EXIF-Ausrichtung

Dieses Makro wurde erstellt, um Bilder aus dem Active Directory in eine Excel-Kalkulationstabelle einzufügen und auf die Zelle zu verkleinern. Es funktioniert ziemlich gut, außer für Bilder, die von einer Quelle stammen, deren Orientierung/Drehung in den EXIF-Daten definiert ist. Also in: 

  • Im Windows Explorer - nicht gedreht 
  • Window Picture Viewer - Nicht gedreht
  • IE - nicht gedreht
  • Chrom - gedreht
  • Excel - gedreht

Es ist alles wegen ein altes Problem von der Kamera, von der das Bild aufgenommen wurde. Jemand postet ein ähnliches Problem , aber es wurde falsch als Duplikat gekennzeichnet und seitdem ignoriert. Ich fand diesen obskuren Post war jemand, der eine Exif-Leserklasse verlinkt hat. Ich habe es getestet und es gab mir den gleichen Orientation-Wert für alle meine Bilder. 

Die Probleme : Das Foto wird richtig gedreht (YAY!), Aber seine Position ist 35-80 Spalten nach rechts (Boo!) Und/oder 200 Zeilen nach unten und die Skalierung ist deaktiviert, da hier die Felder für Breite und Höhe gemischt werden (Boo! x2).

Hier ist mein 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

Die Bildabmessungen können von unbekannten Quellen abweichen (aber ich bin mir ziemlich sicher, dass wir Samsung die Schuld dafür geben können). Suchen Sie nach einer Lösung und/oder einer Erklärung, ohne dass eine Drittanbieteranwendung erforderlich ist.

Hier ist ein Beispiel der Bilder zum Ausprobieren, das erste Bild funktioniert einwandfrei, die anderen nicht. 

12
Martin Sing

Sie müssen die Drehung prüfen, um zu sehen, ob Sie Höhe oder Breite (oben oder links) anpassen müssen.

Passen Sie Ihre Schleife wie folgt an:

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