Microsoft Excel

Herbers Excel/VBA-Archiv

Bildausrichtung erkennen und anpassen

Betrifft: Bildausrichtung erkennen und anpassen von: Roland
Geschrieben am: 24.10.2020 20:13:46

Hallo,
Ich möchte 2 Bilder nebeneinander in einer Zelle einfügen, das klappt soweit, lediglich gelingt es mir nicht ein "Hochkant- Foto" von einem "Querliegenden- Foto" zu unterscheiden und entsprechend zu formatieren.
Es wird immer die längere Seite als "width" angepasst. Es sollte aber so sein, dass die beiden Bilder möglichst groß nebeneinander in der gleichen Zelle eingefügt werden ohne über deren Ränder hinauszuspringen, d.h. das Hochkantbild müsste verkleinert werden.
Irgendwo habe ich da einen Denkfehler oder die Auswertung funktioniert nicht wie es soll.
Gibt es eine Möglichkeit die Ausrichtung des Bildes festzustellen (Hoch oder Quer?)

Vielen Dank für jede Hlfe

Hier mein Macro:

Sub T_ransfer()
Dim Bild_1 As Variant
Dim Bild_2 As Variant
Dim rngZelle As Range
Dim sngTop As Single
Dim sngLeft As Single
Dim sngWidth As Single
Dim sngHeight As Single
Dim picPic As Picture
Dim wksT As Worksheet
Dim Weg As String
Dim Verz As String
Dim ziel As String

Set wksT = activesheet
Set rngZelle = wksT.Cells(77, 1)

sngTop = rngZelle.Top + 20
sngLeft = rngZelle.Left + 15
sngHeight = 250
sngWidth = 350

Weg = "I:\Projekte Tirol\"
Verz = Weg & Left(Range("d2").Value, 3) & "*"
ziel = Dir(Verz, vbDirectory)

ChDrive "I"
ChDir Weg & ziel

Bild_1 = Application.GetOpenFilename( _
    FileFilter:="JPEG Files (*.jpg), *.jpg", _
    title:="                Bild 1 auswählen", _
    MultiSelect:=False)
If VarType(Bild_1) = vbBoolean Then Exit Sub
 
Bild_2 = Application.GetOpenFilename( _
    FileFilter:="JPEG Files (*.jpg), *.jpg", _
    title:="                Bild 2 auswählen", _
    MultiSelect:=False)
If VarType(Bild_2) = vbBoolean Then Exit Sub
 
On Error Resume Next
    wksT.Shapes("Bild 1").Delete
    wksT.Shapes("Bild 2").Delete
On Error GoTo 0

With activesheet.Pictures.Insert(Bild_1)
    With .ShapeRange
         .LockAspectRatio = msoTrue
            If .Height > sngHeight Then .Height = sngHeight
           If .Width > sngWidth Then .Width = sngWidth
    .Top = sngTop
    .Left = sngLeft
    End With
    
    .Name = "Bild 1"
    .SendToBack
End With

With activesheet.Pictures.Insert(Bild_2)
    With .ShapeRange
        .LockAspectRatio = msoTrue
           If .Height > sngHeight Then .Height = sngHeight
           If .Width > sngWidth Then .Width = sngWidth
    .Top = sngTop
    .Left = sngLeft + 350
    End With
     .Name = "Bild 2"
    .SendToBack
End With
End Sub

Betrifft: AW: Bildausrichtung erkennen und anpassen
von: onur
Geschrieben am: 24.10.2020 23:11:22

Füge noch eine Bedingung hinzu:
If .Height < .Width Then
    If .Height > sngHeight Then .Height = sngHeight
    If .Width > sngWidth Then .Width = sngWidth
Else
    ....
    ....


Betrifft: AW: Bildausrichtung erkennen und anpassen
von: Roland
Geschrieben am: 25.10.2020 11:06:42

Hallo,
Danke für die Rückmeldung, das funktioniert aber bei mir leider nicht,

Die längere Seite des Bildes wird immer as "width" interprediert, unabhängig davon ob das die Höhe oder Breite des Bildes ist... eigendlich sollte es so sein, das unabhängig vom Bildformat die Höhe maximal 250 ist und die Breite maximal 350 ist, die Proportionen sollen gleich bleiben und entweder wird durch die Höhe und/oder Breite die Bildgröße bestimmt, in keinem Fall soll eines der Maße über die Grenzen hinausragen.

derzeit wird aber immer die längere Seite, unabhängig ob es Höhe oder Breite ist, auf 350 festgesetzt???

ich verzweifle mittlerweile...

Betrifft: AW: Bildausrichtung erkennen und anpassen
von: onur
Geschrieben am: 25.10.2020 12:47:19

"Die längere Seite des Bildes wird immer as "width" interprediert, unabhängig davon ob das die Höhe oder Breite des Bildes ist." - das ist BLÖDSINN.
Guckst du hier:
https://www.herber.de/bbs/user/141066.xlsm

Betrifft: AW: Bildausrichtung erkennen und anpassen
von: Roland
Geschrieben am: 25.10.2020 13:37:16

Hallo,

Vielen Dank für die Antwort, auch wenn mein Problem kein Blödsinn ist.
Ich habe mit deinem Makro einmal ein Hochkantbild und einmal ein Querbild eingespielt
Ergebnis: beides Mal wird in height und width der gleiche Wert angezeigt!

Eigentlich müssten die Werte sich ja vertauschen!

Als Ergebnis sollte dann aber das Hochkantbild genauso hoch sein wie das Querbild hoch ist und dann eben proportional schmäler sein......

https://www.herber.de/bbs/user/141067.xlsm

Ich hoffe du verstehst jetzt was ich meine...
Danke

Betrifft: AW: Bildausrichtung erkennen und anpassen
von: onur
Geschrieben am: 25.10.2020 13:55:42

Mein Gott, ist das denn so schwer???? WAS angezeigt wird, ist doch irrelevant, es wird immer nur Daten des letzten Bildes angezeigt.
GUCKST DU HIER:
https://www.herber.de/bbs/user/141068.xlsm

Betrifft: AW: Bildausrichtung erkennen und anpassen
von: Roland
Geschrieben am: 25.10.2020 15:48:17

Hallo,
Danke für deine Hilfe.
es ist ein interessantes Phänomen:

Wenn ich deine Excel mit Fotos von einem Androidhandy laufen lasse funktioniert es einwandfrei, nehme ich jedoch die Fotos von einem IPhone 8 funktioniert das nicht sondern läuft so wie oben beschrieben!!

In den exif daten der Fotos werden aber die Auflösung richtig dargestellt.....

Jetzt bin ich total ratlos......

Betrifft: AW: Bildausrichtung erkennen und anpassen
von: Roland
Geschrieben am: 25.10.2020 12:32:15

Hallo,
Danke für die Rückmeldung, das funktioniert aber bei mir leider nicht,

Die längere Seite des Bildes wird immer as "width" interprediert, unabhängig davon ob das die Höhe oder Breite des Bildes ist... eigendlich sollte es so sein, das unabhängig vom Bildformat die Höhe maximal 250 ist und die Breite maximal 350 ist, die Proportionen sollen gleich bleiben und entweder wird durch die Höhe und/oder Breite die Bildgröße bestimmt, in keinem Fall soll eines der Maße über die Grenzen hinausragen.

derzeit wird aber immer die längere Seite, unabhängig ob es Höhe oder Breite ist, auf 350 festgesetzt???

ich verzweifle mittlerweile...

Beiträge aus dem Excel-Forum zum Thema "Bildausrichtung erkennen und anpassen"