Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1648to1652
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

Bilder mit VBA kopieren/löschen etc.

Bilder mit VBA kopieren/löschen etc.
09.10.2018 13:18:19
ExelGeenhorn
Hallo zusammen,
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bilder mit VBA kopieren/löschen etc.
09.10.2018 16:30:30
fcs
Hallo Excelgreenhorn,
mehrere Probleme:
1. In der Zeile, die das Einfügen starten soll muss das ".Value" weg, da deine Sub hier als Parameter ein Range-Object erwartet.
2. Fehlende Bilder im Ablauflaufplan oder in Detais_Artikel lösen Fehler aus, da kein Objekt vorhanden.
Hier muss eine Fehlerbehandlung erfolgen.
3. Ablaufplan.Range(Ziel).Paste funktioniert auch nicht
Hier muss man die Zelle selektieren und im Blatt einfügen - dann wird Bild direkt in Zelle plaziert
oder
Einfach im Blatt einfügen und dann so wie du es gemacht hast das Bild in der Zelle positionieren.
Sonstiges:
1. Du hast eine komplizierte Art gewählt, um die Bilder anzusprechen (wahrscheinlich durch den Makro-Rekorder-Man kann die Shape-Objekte hier auch direkt per Name ansprechen.
2. Die Art wie du die Namen der Bilder berechnest kann Probleme bereiten.
Als Bildname kommt bei dir durch verwenden der Str-Funktion mt Leerzeichen raus z.B. " 6 7".
Ohne Leerzeichen: einfach ohne Str-Funktion per & Zeilen- und Spaltennummer zusammensetzen
Und theoretisch könnten in Ziel und Quelle auch identische Namen vorkommen.
Deshalb würde ich die Bildnamen zusätzlich mit vorangestelltem Buchstaben benamen.
"Q 2 5" in Details_Artikel
"Z 6 7" im Ablaufplan
etc.
3. im Unterprogramm kannst du die Prüfung ob die Bilder vorhanden sind, weglassen, da diese Prüfung ja schon Hauptprogramm durchgeführt wird.
LG
Franz
'....
Dim objShape As Shape, strNameShape As String, iFehler As Integer
On Error GoTo Fehler
iFehler = 1
strNameShape = (5 + Nr_Prozessschritt) & 7
Set objShape = Ablaufplan.Shapes(strNameShape)
If Not objShape Is Nothing Then
objShape.Delete
End If
Resume_01:
iFehler = 2
strNameShape = (Zeile_Details_Artikel + 1) & Spalte_Details
Set objShape = Details_artikel.Shapes(strNameShape)
If Not objShape Is Nothing Then
Call Bild_einfuegen(Ablaufplan.Cells(5 + Nr_Prozessschritt, 7), _
Details_artikel.Cells(Zeile_Details_Artikel + 1, Spalte_Details))
End If
Resume_02:
Next
'Fehler-Behandlung am Ende des Makros
Fehler:
With Err
Debug.Print "Fehler: " & .Number
Select Case .Number
Case 0 'OK
Case -2147024809 'Shape-Element mit Name nicht gefunden
Select Case iFehler
Case 1: Resume Resume_01
Case 2: Resume Resume_02
End Select
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
'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
Dim objShapeZ As Shape
Dim objShapeQ As Shape
On Error GoTo Fehler
Bildname_Quelle = Quelle.Row & Quelle.Column
Bildname_Ziel = Ziel.Row & Ziel.Column
Set objShapeQ = Details_artikel.Shapes(Bildname_Quelle)
'Prüfungen können entfallen, da schon im Hauptmakro vorhanden
'  If Not objShapeQ Is Nothing Then 'Wenn Bild in _
Details vorhanden ist
'    Set objShapeZ = Ablaufplan.Shapes(Bildname_Ziel)
'    If Not objShapeZ Is Nothing Then
'      objShapeZ.Delete
'    End If
objShapeQ.Copy
'    Ziel.Select
Ablaufplan.Paste
Set objShapeZ = Ablaufplan.Shapes(Bildname_Quelle)
objShapeZ.Name = Bildname_Ziel
With objShapeZ
.Left = Ziel.Left
.Top = Ziel.Top
.Width = Ziel.Width
.Height = Ziel.Height
End With
'End If
Fehler:
With Err
Select Case .Number
Case 0 'OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Anzeige
AW: Bilder mit VBA kopieren/löschen etc.
12.10.2018 15:33:53
ExelGeenhorn
Hi Franz,
wow danke für diese 1A umfangreiche Hilfe!! Funktioniert super und ich habe direkt den Tipp mit den Buchstaben für die eindeutige Benennung einfließen lassen. Ich hatte leider etwas viel zu tun, weshalb ich jetzt erst zum testen/ändern gekommen bin.
Vielen Dank du hast mir sehr geholfen
Gruß
Excelgreenhorn

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige