Office: Bild aus Zwischenablage einfügen

Hallo,
Bitte um Makro Hilfe!

Wie kann ich ein Bild (Shape) aus der Zwischenablage in die Aktive Zelle
übernehmen wobei das Bild in der Zelle in Höhe und Breite eingepasst werden soll?

Vielen Dank für die Hilfe
Gruß Derhard

:)

 

Hi,

vielleicht so:

Code:

 

Hallo Karin,
Vielen Dank für deine Hilfe,
das in der Zwischenablage kopierte Bild wird zwar in die markierte Zelle
eingefügt, aber nicht passgenau der Zellgröße!
Das Bild sollte unabhängig von der Zellbreite und Zellhöhe eingepasst sein.
Gruß Derhard

 

Hallo,

vielleicht meinst du es so?
Code:

VG
Santa

 

Hi,

derzeit wird das Bild unverzerrt eingefügt und nur die Höhe an die Zellhöhe angepasst. Soll das Bild verzerrt werden, sodass Höhe und Breite mit der Zellgröße übereinstimmen?

Code:

 

Hallo Karin,
Vielen Dank für die Makro Hilfe,
Ich habe das Makro noch erweitert, sodass es jetzt für meine Zwecke passt!
Gruß Derhard
Sub BildEinfuegen_01()
ActiveSheet.Paste
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = msoFalse
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.Height = ActiveCell.Height
.Width = ActiveCell.Width
End With
End Sub

 

Darf ich mich auch mal anhängen? Ich habe eine Excel-Mappe (ich habe hier nur den benötigten Teil angefügt), in der ich das angefügte Blatt jeweil mit 2 Screenshots befüllen muß.
Da die Screenshots jedoch in der Größe variieren, habe ich das Problem, daß die Grafik entweder zu hoch oder zu lang eingefügt wird - eine Verzerrung soll nicht erfolgen.
Läßt sich das wie folgt realisieren:
1. Grafik auf Höhe der Zelle justieren
2. Dann überprüfen, ob die Länge der Grafik größer als die der Zelle ist
3. a) Länge ist nicht größer als Zelle, dann das Shape zentrieren
b) Länge ist größer als Zelle, dann Zellenlänge als Fixwert setzen und das Shape zentrieren
4. Da dieses Blatt Teil ursprünglich Teil einer größeren Mappe ist, die immer wieder neu befüllt wird, habe ich einen Button auf einem anderen Blatt, welcher alle zu befüllenden Zellen der Mappe löscht - wie kriege ich es hin, daß auch die Shapes auf diesem Blatt gelöscht werden, ohne die Druch- und Einfügebuttons zu löschen? Die Shapes werden doch dynamisch bezeichnet, oder? Es soll, vereinfacht gesagt, die Grafik in A5 und A9 gelöscht werden.

Ich habe mal meine Testdatei angefügt. Das jeweilige Bild wird mit einem Button eingefügt, welcher die jeweilige Zelle auswählt und dann den Code ( siehe Modul9) ausführt.

Vielen Dank im voraus.
Werner

 

Ok - Punkte 1 - 3 habe ich wie folgt gelöst:

Code:

Sub BildPSLEinfuegen()
    Range("A5").Select
    ActiveSheet.Paste
    With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
        .LockAspectRatio = msoTrue
        .Height = ActiveCell.Height - 10
        If .Width > ActiveCell.Width Then .Width = ActiveCell.Width - 10
        .Left = ActiveCell.Left + ActiveCell.Width / 2 - .Width / 2
        .Top = ActiveCell.Top + ActiveCell.Height / 2 - .Height / 2
    End With
End Sub
_________________________________________________________________________
Sub BildVerkabelungEinfuegen()
    Range("A9").Select
    ActiveSheet.Paste
    With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
        .LockAspectRatio = msoTrue
        .Height = ActiveCell.Height - 10
        If .Width > ActiveCell.Width Then .Width = ActiveCell.Width - 10
        .Left = ActiveCell.Left + ActiveCell.Width / 2 - .Width / 2
        .Top = ActiveCell.Top + ActiveCell.Height / 2 - .Height / 2
    End With
End Sub

Hinweis: Indem ich von .Height und .Width jeweils 10 abziehe, erhalte ich einen kleinen Freiraum zwischen der Linie um Zelle A5 bzw. A9.
Jetzt fehlt mir nur noch die Möglichkeit, per Button ausschließlich die beiden Shapes zu entfernen, die auf A5 bzw. A9 gezeichnet wurden.

 

Habe jetzt soweit alles mit diesem Code gelöst:

Code:

Code:
Sub BildPSLEinfuegen()
    Range("A5").Select
    ActiveSheet.Paste
    With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
        .Name = "PSL"
        .LockAspectRatio = msoTrue
        .Height = ActiveCell.Height - 10
        If .Width > ActiveCell.Width Then .Width = ActiveCell.Width - 10
        .Left = ActiveCell.Left + ActiveCell.Width / 2 - .Width / 2
        .Top = ActiveCell.Top + ActiveCell.Height / 2 - .Height / 2
    End With
End Sub
_________________________________________________________________________
Sub BildVerkabelungEinfuegen()
    Range("A9").Select
    ActiveSheet.Paste
    With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
        .Name = "Verkabelung"
        .LockAspectRatio = msoTrue
        .Height = ActiveCell.Height - 10
        If .Width > ActiveCell.Width Then .Width = ActiveCell.Width - 10
        .Left = ActiveCell.Left + ActiveCell.Width / 2 - .Width / 2
        .Top = ActiveCell.Top + ActiveCell.Height / 2 - .Height / 2
    End With
End Sub

Jetzt stellt sich (mir) nur eine Frage:
Wie kann ich in dem jeweiligen Makro prüfen, ob eventuell der Shape "PSL" (Makro1) oder "Verkabelung" (Makro2) schon exisitiert und falls ja, diesen vorab löschen?