Bildbreite und Bildhöhe auslesen und übergeben?
#11
Hallo Andreas,

ich kann Dein Problem nicht nachstellen.

Beides funktioniert doch.

Das Querbild wird immer dort eingefügt, wo der Cursor steht. 
Hier sollte vielleicht Set AC = Range("T5:AJ17") genommen werden.

Das Hochbild wird immer in Range("B5:R17") eingefügt, egal wo der Cursor steht.

Wie ein Bild bei Dir in BM5 kommt, kann ich nicht nachvollziehen.

Gruß
Karl-Heinz
Top
#12
Hallo André,

Ist "diesen Range-Bereich" immer "B5:R17"?

Nein, nur die Größe des Range-Bereiches ist immer gleich.
Es gibt auf dem Sheet mindestens 15 gleichgroße Range-Bereiche.

Bitte mit der Excel Datei  testen, das Hochformatbild  DSC_0242.jpg  landet nicht da wo es hin soll.

Grüße, Andreas

Hallo Karl-Heinz,

siehe mein Filmchen im Anhang,

Grüße, Andreas


Angehängte Dateien
.zip   Hochformat.zip (Größe: 867,55 KB / Downloads: 1)
Top
#13
Hallo Andreas,

es sieht so aus, das was passiert, was nicht sein kann.
Aber vielleicht passiert bei Dir ein Fehler. Da setzen wir die Positionierung nochmal untendrunter.

Hier noch ein Versuch, der die Bilder ausgehend vom aktivierten gelben Feld dort mit einem immer gleichen, erweiterten Bereich einfügt.
Steht der Cursor nicht in einem gelben Feld, passiert nichts.

Code:

Option Explicit

Sub Bildquer_Einfuegen()
  Bild_Einfuegen 0
End Sub

Sub Bildhoch_Einfuegen()
  Bild_Einfuegen 1
End Sub

Sub Bild_Einfuegen(Index As Integer)
' Sub fügt ein Bild in eine Zelle/Bereich ein
  Dim AC As Range, oPic As Object
  Dim BildQuelle(1) As String
  
  BildQuelle(0) = "C:\Users\Andreas\Desktop\Raffael Rückbau\01_Rohdaten\after\DSC_0235.jpg" ' Querformat
  BildQuelle(1) = "C:\Users\Andreas\Desktop\Raffael Rückbau\01_Rohdaten\after\DSC_0242.jpg"  ' Hochformat

' Bereich setzen, auch verbundene Zellen oder Range
  If ActiveCell.Interior.Color <> 65535 Then Exit Sub   ' Nur bei gelben Feld aktiv
  Set AC = ActiveCell.Resize(13, 17) '=> Rangebereich immer vom aktiven Feld auf x Zeilen, Spalten ausgedehnt.

'' Bild einfügen in linke obere Ecke, Originalgröße
  Set oPic = ActiveSheet.Shapes.AddPicture(BildQuelle(Index), False, True, AC.Left + 1, AC.Top + 1, -1, -1)
  
  MsgBox "Bildbreite: " & oPic.Width & " und " & "Bildhöhe: " & oPic.Height
  
  If Not oPic Is Nothing Then
     oPic.Left = AC.Left + 1
     oPic.Top = AC.Top + 1
     If oPic.Width > oPic.Height Then       ' Querformat
        oPic.Width = AC.Width - 2
        If oPic.Height > AC.Height Then oPic.Height = AC.Height - 2
     Else
        oPic.Height = AC.Height - 2         ' Hochformat
        If oPic.Width > AC.Width Then oPic.Width = AC.Width - 2
     End If
  End If
End Sub

_________
viele Grüße
Karl-Heinz
Top
#14
Habs gefunden. Das Hochformatbild hat, warum auch immer, nach dem Einfügen, einen 90° Winkel. Dadurch wird das Bild an der falschen Stelle skaliert.

Jetzt Läuft es.

Danke an Alle Helfer.

Gruß, Andreas
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste