17.01.2021, 19:20 (Dieser Beitrag wurde zuletzt bearbeitet: 17.01.2021, 20:16 von volti.)
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
' 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.
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