VBA-Erweitern um vorhandenes Bild löschen

[Tuempeltaucher]

Hallo,

ich hab folgendes Problem, hab hier ein Makro gefunden um Bilder zu einer Artikelnr.
einzufügen. Rufe ich nun einen neuen Artikel auf, wird das aktuelle Bild nicht gelöscht,
sondern das neue Bild wird draufgesetzt.
Kann mir einer das Makro erweitern, so das immer nur das Bild zur Artikelnummer im
Arbeitsblatt angezeigt wird.
Hab leider überhaupt kein Plan von VBA.

Hier nun das Makro:

Code:

Sub BilderEinfuegen()
  Dim zeile As Long
  Dim bild As String
  Dim lzeile As Long
  For Each shp In ActiveSheet.Shapes
     If shp.Type = msoPicture Then shp.Delete
  Next
  Dim Pfad As String, Wiederholungen As Long
 
  'Pfad für die Bilder - anpassen!!!
  Pfad = "X:\Abteilungen\Betriebstechnik\Kleingeraetrepruefung_BGVA3\Bilder_BGVA3\"
 
  'Alles spielt sich auf dem aktuellen Arbeitsblatt ab
  With ActiveSheet
     
     'letzte Zeile in Spalte C des Arbeitsblattes ermitteln
     lzeile = .Cells(Rows.Count, 3).End(xlUp).Row
     
     'Ab Zeile 3 die Zeilen durchlaufen
     For zeile = 3 To lzeile Step 17
       
        'Name des Bildes einlesen und die Endung .jpg hinzufügen und mit Pfad-Konstante kombinieren
        bild = Pfad & .Cells(zeile, 3).Value & ".jpg"
       
        'prüfen, ob überhaupt ein Bild vorhanden ist
        If Len(Dir(bild)) = 0 Then
           .Cells(zeile + 2, 1) = "Kein Bild mit dem Namen " & .Cells(zeile, 3).Value & ".jpg gefunden!"
        Else
           'Bild einfügen
           .Pictures.Insert (bild)
           With .Pictures(.Pictures.Count)
              .Top = 300     'Zelle in der das Bild eingefügt wird - oben
              .Left = 300     'links
              .ShapeRange.ScaleWidth 1, msoFalse, msoScaleFromTopLeft   'Bild skalieren - Breite
              .ShapeRange.ScaleHeight 1, msoFalse, msoScaleFromTopLeft   'Höhe
           End With
        End If
     Next zeile
  End With
End Sub

Gruß
Frank

[schauan]

Hallo Frank,

ich weiß nun nicht, ob in dem Blatt noch mehr Bilder sind, können denn in dem Blatt alle anderen Bilder gelöscht werden?

[Tuempeltaucher]

Hallo Frank,

ich weiß nun nicht, ob in dem Blatt noch mehr Bilder sind, können denn in dem Blatt alle anderen Bilder gelöscht werden?

Hallo Andre`,

erst mal Danke für Deine Antwort.
Es befinden sich keine anderen Bilder auf dem Datenblatt.


Gruß
Franlk

[schauan]

Hallo Frank,

dann ist es recht einfach. Du brauchst nur eine Zeile mehr code. Das ist die hier fett gedruckte. Ich hab mal noch etwas davor und danach gepostet, das Du siehst, wo sie hin kommt. Die Zeile löscht alle Bilder auf dem Blatt.

Code:

'Alles spielt sich auf dem aktuellen Arbeitsblatt ab
  With ActiveSheet
[b]    .Pictures.Delete
[/b]     'letzte Zeile in Spalte C des Arbeitsblattes ermitteln

Am Anfang die 3 Löschzeilen können dann raus:

Code:

For Each shp In ActiveSheet.Shapes
     If shp.Type = msoPicture Then shp.Delete
  Next

[Tuempeltaucher]

Hallo Frank,

dann ist es recht einfach. Du brauchst nur eine Zeile mehr code. Das ist die hier fett gedruckte. Ich hab mal noch etwas davor und danach gepostet, das Du siehst, wo sie hin kommt. Die Zeile löscht alle Bilder auf dem Blatt.

Code:

 'Alles spielt sich auf dem aktuellen Arbeitsblatt ab
 With ActiveSheet
[b]    .Pictures.Delete
[/b]     'letzte Zeile in Spalte C des Arbeitsblattes ermitteln

Am Anfang die 3 Löschzeilen können dann raus:

Code:

 For Each shp In ActiveSheet.Shapes
    If shp.Type = msoPicture Then shp.Delete
 Next

Hallo Andre,

vielen Dank für Deine Hilfe.
Arbeitsmappe funktioniert nun so wie ich es möchte.

Gruß
Frank