Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA-Erweitern um vorhandenes Bild löschen
#1
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
Antworten Top
#2
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?
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • Tuempeltaucher
Antworten Top
#3
(09.12.2015, 20:45)schauan schrieb: 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
Antworten Top
#4
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
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#5
(12.12.2015, 19:58)schauan schrieb: 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
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste