Bilder mit VBA kopieren/löschen etc.
09.10.2018 13:18:19
ExelGeenhorn
ich habe schon diverse Probleme mit Antworten aus dem Forum lösen können, leider habe ich aber hier noch nichts passendes gefunden (korrigiert mich bitte, falls ich etwas übersehen habe).
Was will ich haben:
Über die Artikelnummer wird ein Ablaufplan mit diversen Zusatzinformationen zusammengesucht und auf ein Tabellenblatt in eine Druckreife Form gebracht. Eine der Zusatzinformationen sollen auch Bilder sein. Es können also optional zu jedem Schritt im Ablauf jeweils ein Bild hinterlegt werden. Dieses soll dann bei der jeweiligen Artikelnummer auf das Hauptblatt("Ablaufplan") kopiert werden. Davor sollte natürlich auch ein Bild was vorher dort abgelegt war gelöscht werden.
Meine Idee:
Ich benenne die Bilder einfach nach den Zellen in denen Sie jeweils abgelegt sind, so kann ich sie einfach wieder finden. Bilder in Excel mit Makro speichern und umbenennen ist erledigt. Problematisch ist bisher noch das Löschen und Kopieren. Wichtige Info: Es muss kein Bild vorhanden sein.
Hier der Aufruf meines Codes im Hauptprogramm mit vorherigem löschen des alten Bildes:
If Not Ablaufplan.Shapes.Range(Array(Str(5 + Nr_Prozessschritt) & Str(7))) Is Nothing Then
Ablaufplan.Shapes.Range(Array(Array(Str(5 + Nr_Prozessschritt) & Str(7)))).Delete
End If
If Not Details_artikel.Shapes.Range(Array(Str(Zeile_Details_Artikel + 1) & Str(Spalte_Details))) Is Nothing Then
Call Bild_einfuegen(Ablaufplan.Cells(5 + Nr_Prozessschritt, 7).Value, Details_artikel.Cells(Zeile_Details_Artikel + 1, Spalte_Details))
End If
Hier das Unterprogramm:
Sub Bild_einfuegen(Ziel As Range, Quelle As Range)
'Dim Bild As Object
Dim Bildname_Quelle As String
Dim Bildname_Ziel As String
Bildname_Quelle = Str(Quelle.Row) & Str(Quelle.Column)
Bildname_Ziel = Str(Ziel.Row) & Str(Ziel.Column)
If Not Details_artikel.Shapes.Range(Array(Bildname_Quelle)) Is Nothing Then 'Wenn Bild in _
Details vorhanden ist
If Not Ablaufplan.Shapes.Range(Array(Bildname_Ziel)) Is Nothing Then
Ablaufplan.Shapes.Range(Array(Bildname_Ziel)).Delete
End If
Details_artikel.Shapes.Range(Array(Bildname_Quelle)).Copy
Ablaufplan.Range(Ziel).Paste
Details_artikel.Shapes.Range(Array(Bildname_Quelle)).Name = Bildname_Ziel
With Details_artikel.Shapes.Range(Array(Bildname_Ziel))
.Left = Ziel.Left
.Top = Ziel.Top
.Width = Ziel.Width
.Height = Ziel.Height
End With
End If
End Sub
Geht mal davon aus, dass die Zeilen/Spaltenbezeichnungen alle so stimmen. Wenn ich das Programm so starten will, bekomme ich zwei Fehler:1. Namen nicht gefunden, bezogen auf die Zeile, die ein vorhandenes Bild finden soll
2. Laufzeitfehler 1004 in der Zeile, wo das Unterprogramm aufgerufen werden soll
Vielen Dank schon mal für euren Input
Gruß
ExcelGreenhorn