Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1832to1836
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bild aus Tabelle kopieren und in andere

Bild aus Tabelle kopieren und in andere
04.06.2021 10:42:25
Jörn
Hallo
Ich habe ein Problem mit dem auswählen eines Bereichs in dem ein Bild liegt.
Wenn ich den Makro Recorder laufen lasse, habe ich das Problem das der Bildname fest steht. Die Grafik Name ist aber jedes mal ein anderer.
Momentan benutze ich dazu folgenden Code um ein Bild deren Name mir nicht bekannt ist zu kopieren und einzufügen:

Sub UnterschriftenKopieren()
Dim Bild As Shape
For Each Bild In Sheets("K Sander-EB").Shapes
If Bild.TopLeftCell.Address = "$R$54" Then
Bild.Copy
With Sheets("K Dateninput-USV")
.Paste .Range("$W$68")
End With
End If
Next
End Sub
Leider ist es so das der Bereich in dem das Bild gesucht wird R54 ist. Eigentlich soll aber ein Bereich von R54 bis AG57 durchforstet werden.
Außerdem würde ich das Bild das im Bereich R54 bis AG57 liegt gern in seiner größe so verkleinern das es anstatt zB. 150x300 Pixel nur noch 100x200 hat.
Kann mir da jemand weiterhelfen? Am liebsten wäre mir ein Code Schnipsel, da ich nicht so versiert bin.
(PS ich habe nicht Cross Gepostet)

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild aus Tabelle kopieren und in andere
04.06.2021 11:51:46
volti
Hallo Jörn,
vielleicht hilft Dir diese Idee weiter....
Code:

[Cc]

Sub UnterschriftenKopieren() Dim Bild As Shape With Sheets("K Sander-EB") For Each Bild In .Shapes If Not Intersect(Bild.TopLeftCell, .Range("R54:AG57")) Is Nothing Then Bild.Copy Sheets("K Dateninput-USV").Select ActiveSheet.Paste With Selection.ShapeRange .LockAspectRatio = False .Left = Range("$W$68").Left .Top = Range("$W$68").Top .HEIGHT = 200: .WIDTH = 100 End With Exit For End If Next Bild End With End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Bild aus Tabelle kopieren und in andere
04.06.2021 12:20:51
Jörn
1000 Dank, es funktioniert super ;-)
AW: Bild aus Tabelle kopieren und in andere
04.06.2021 12:29:12
volti
Hallo Jörn,
vielen Dank für die Rückmeldung.
Dann sollte der Beitrag nicht mehr als offen gekennzeichnet sein :-)
Gruß KH
AW: Bild aus Tabelle kopieren und in andere
04.06.2021 13:03:50
Jörn
Ok ich hatte überlesen das der Haken "NICHT Beantwortet" bedeutet... mein fehler
Noch ne Kurze Frage... Wenn sich KEIN Bild im gesuchten Bereich befindet dann gibt es eine Fehlermeldung. Kann man das umgehen?
Danke
AW: Bild aus Tabelle kopieren und in andere
04.06.2021 13:25:04
volti
Hallo Jörn,
bei mir kommt kein Fehler, auch ohne Bild nicht...
Fehler kann man abfangen, z.B. wie in diesem Beispiel.
Code:

[Cc][+][-]

Option Explicit Sub UnterschriftenKopieren() Dim Bild As Shape On Error GoTo Fehler With Sheets("K Sander-EiB") For Each Bild In .Shapes If Not Intersect(Bild.TopLeftCell, .Range("R54:AG57")) Is Nothing Then Bild.Copy Sheets("K Dateninput-USV").Select ActiveSheet.Paste With Selection.ShapeRange .LockAspectRatio = False .Left = Range("$W$68").Left .Top = Range("$W$68").Top .Height = 200: .Width = 100 End With Exit For End If Next Bild End With Exit Sub Fehler: MsgBox "Es ist der Fehler '" & Error & "' aufgetreten!", vbCritical, "Fehler" End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Bild aus Tabelle kopieren und in andere
04.06.2021 13:29:24
volti
Hallo Jörn,
bei mir kommt kein Fehler, auch ohne Bild nicht...
Fehler kann man abfangen, z.B. wie in diesem Beispiel.
Code:

[Cc][+][-]

Option Explicit Sub UnterschriftenKopieren() Dim Bild As Shape On Error GoTo Fehler With Sheets("K Sander-EiB") For Each Bild In .Shapes If Not Intersect(Bild.TopLeftCell, .Range("R54:AG57")) Is Nothing Then Bild.Copy Sheets("K Dateninput-USV").Select ActiveSheet.Paste With Selection.ShapeRange .LockAspectRatio = False .Left = Range("$W$68").Left .Top = Range("$W$68").Top .Height = 200: .Width = 100 End With Exit For End If Next Bild End With Exit Sub Fehler: MsgBox "Es ist der Fehler '" & Error & "' aufgetreten!", vbCritical, "Fehler" End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Bild aus Tabelle kopieren und in andere
04.06.2021 17:17:31
Jörn
Und wieder einmal kann ich mich nur bedanken... es läuft tadellos ;-)

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige