2.2k Aufrufe
Gefragt in Tabellenkalkulation von
Bearbeitet von halfstone
Super Code...

Hi Oliver, das ist ja super. Ich suche schon lange Zeit noch solch einer einfachen Methode...

Ich habe den letzten Code in ein Modul kopiert, wie in der Beschreibung vorher zu lesen war. Es klappt wirklich sehr gut.

Nun würde mich noch folgendes interessieren:
1) Die Bilder werden alle an 1 Stelle eingefügt. Ich bräuchte die Bilder jedoch jeweils in der Zelle, wo die Artikelnummer steht, bzw eine Spalte daneben.

2) die Bilder sind ggf. alle unterschiedlich groß... ich würde diese gern alle einheitlich haben wollen. Geht das?

Mein verwendeter Code ist:

Option Explicit

Sub Bilder_einfügen()
Dim Pfad As String, Wiederholungen As Long
On Error Resume Next
Pfad = "G:\Bilder\"
For Wiederholungen = 2 To Range("A65536").End(xlUp).Row
Cells(Wiederholungen, 3).Activate
ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg").Select
Next
End Sub

Würde mich freuen, wenn du/ihr mir helfen könntet.

Gruß Thomas

20 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Thomas,

schon wieder ein Thread mit Bildern ;-).

Probier mal den folgenden Code:

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long

Pfad = "G:\Bilder\"

'Spalte A ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Namen der Bilder stehen in Spalte A - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 1).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte B eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 2).Left, Cells(Wiederholungen, 2).Top, 85, 85
Else
'falls nein, wird in Spalte B eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 2) = "Bild nicht gefunden"
End If
Next

End Sub


Die Göße der Bilder kannst du selbst nach Bedarf ändern.

Gruß

M.O.

P.S.: Eine etwas aussagekräftigere Überschrift wäre besser gewesen.
0 Punkte
Beantwortet von
Hi M.O.

ich bin echt fast sprachlos. Ich hab das nun noch geringfügig angepasst und bin happy.
Nun wäre meine Frage: Wie kann ich daraus eine Art AddIn machen.
Bei meinen Rechnern sind i.d.R. Makros deaktiviert - spätetestens seit dem Locky-Virus.
Gibt es eine Möglichkeit diese "Funktion" nur in dieser Datei freizugeben und immer per Knopfdruck oder Button ausführen zu lassen?

Schon mal vielen Dank ;-)
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Thomas,

wenn du ein Add-In daraus machst, wird das Makro allgemein in Excel zur Verfügung gestellt (lies dazu z.B. mal hier nach). Aber das willst du ja gerade nicht.

Erstelle auf deinem Arbeitsblatt einen Button (Anleitung) und füge dann den Code - alles was zwischen Sub und End Sub steht, aber ohne diese beiden Zeilen, dann in das VBA-Projekt der Schaltfläche ein.
Dein Code müsste dann etwa so aussehen:

Private Sub CommandButton1_Click()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long

Pfad = "G:\Bilder\"

'Spalte A ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Namen der Bilder stehen in Spalte A - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 1).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte B eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 2).Left, Cells(Wiederholungen, 2).Top, 85, 85
Else
'falls nein, wird in Spalte B eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 2) = "Bild nicht gefunden"
End If
Next
End Sub


Dann wird der Code nur in dieser Datei und durch diese Schaltfläche ausgelöst. Den Code im allgemeinen Modul kannst du dann löschen.

Im Sicherheitscenter von Excel kannst du ja einstellen, dass Makros mit Benachrichtigung deaktiviert werden. Dann musst du beim ersten Aufruf das Makro aktivieren. Bei künftigen Aufrufen wird das Dokument dann sofort mit Makros geöffnet.

Gruß

M.O.
0 Punkte
Beantwortet von
Ähmmm, der Thread hat offenbar einen Vorlauf, den niemand kennt.

Schreibt doch bitte im Ausgangsthread weiter, damit der Zusammenhang erhalten bleibt.

Ich kann jedenfalls damit nichts anfangen.
0 Punkte
Beantwortet von
Hi M.O. ,

also das klappt alles super.
2 Sachen habe ich noch:

1. kann man bevor die Bilder neu eingelesen werden noch alle Objekte entfernen ... also was über folgende Tastenkombi auch geht: Strg+g --> Atl+I --> Alt +J. Ich würde diese Funktion gern vor dem Bildeinlesen, beides aber mittels 1 Knopf ausführen.

2. Kann ich vllt festlegen das Bilder einer bestimmten Zeile, Spalte oder gar Zelle in einer anderen Größe eingelesen werden?

Ich hoffe, dass ist nicht zu verwirrend geschrieben... und freue mich auf baldige Rückmeldung.

Vielen Dank bereits vorab.

***Gruß TausH
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

wenn du vor dem Einfügen alle Bilder löschen willst, dann ergänze das in Anwort 3 gepostete Makro wie folgt:
Private Sub CommandButton1_Click()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim shp As Shape

Pfad = "G:\Bilder\"

'Alle vorhandenen Bilder im aktiven Blatt löschen
For Each shp In ActiveSheet.Shapes
shp.Delete
Next

'Spalte A ab Zeile 2 durchlaufen
...


Man kann auch die Größe der einzelnen Bilder festlegen. Die müsste aber irgendwo definiert sein, so wie in diesem Thread.

Gruß

M.O.
0 Punkte
Beantwortet von
Hi M.O.,

super vielen Dank. Das ist echt der Wahnsinn .. wie lang habe ich noch so etwas gesucht!!!

Nachfolgend mein Code:
__________________________________________________
Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim shp As Shape

On Error Resume Next

Pfad = "G:\Bilder\"

'Alle vorhandenen Bilder im aktiven Blatt löschen
For Each shp In ActiveSheet.Shapes
shp.Delete
Next

'Spalte A ab Zeile 2 durchlaufen
For Wiederholungen = 7 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Namen der Bilder stehen in Spalte A - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 5).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte B eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 5).Left, Cells(Wiederholungen, 5).Top, 49, 49

End If
Next
End Sub
__________________________________________________

Ich würde nun gern noch ein Bild 10x10cm in Zelle E1 einfügen (Maße und Zelle variabel), bekomme das aber mit den verlinkten Threads nicht hin... das geht bestimmt auch noch oder?
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

das Problem ist, das Makro muss wissen, in welche Zelle welches Bild in welcher Größe eingefügt werden soll.
Ich lese deine Frage so, dass in Spalte B die Bilder alle wie gehabt in der gleichen Größe eingefügt werden sollen. Nur willst du dann noch ein (odere mehrere?) Bilder in einer Zelle mit einer Größe eingefügt haben, die du für jedes Bild festlegen willst.

Dann müsstest du irgendwo in deinem Blatt einen Bereich definieren, in du
- die Zelle, in die das Bild eingefügt werden soll
- den Namen des Bildes
- die Höhe des Bildes
- und die Breite des Bildes
angibst.

Dann könnte das Bild entsprechend deiner Daten eingefügt werden.

Gruß

M.O.
0 Punkte
Beantwortet von
Hi M.O.

- die Zelle, in die das Bild eingefügt werden soll: E1
- den Namen des Bildes: E1
- die Höhe des Bildes: 10cm
- und die Breite des Bildes: 10cm
angibst.

ich weiß nur nicht wie man das genau schreibt.

Beim löschen aller Objekte wird leider auch immer der "Button" mit gelöscht. Kann man das auch umgehen?

Danke und Gruß

TausH
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

ändere den Teil für das Löschen der Bilder wie folgt:

For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Picture" Then shp.Delete
Next


Zu deinem Bild in E1: Wenn du immer ein Bild bestimmtes Bild in E10 mit der Größe 10 cm x 10 cm einfügen willst, dann ist das kein Problem.

Da du aber geschrieben hast:
Ich würde nun gern noch ein Bild 10x10cm in Zelle E1 einfügen (Maße und Zelle variabel)

gehe ich mal davon aus, dass nicht immer die Zelle E1 genommen werden soll und nicht immer die Größe 10 cm x 10 cm genommen werden soll. Dann musst du die Angaben im Tabellenblatt machen.
Bsp:
- in die Zelle X1 schreibst du den Namen des Bildes (ohne Endung)
- in die Zelle X2 schreibst du die Zelle, in der das Bild eingefügt werden soll; z.B. E1
- in die Zelle X3 schreibst du die Höhe in cm; z.B. 10
- in die Zelle X4 schreibst du die Breite in cm, z.B. 10

Dann führe mal den folgenden ergänzten Code aus:

Private Sub CommandButton1_Click()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim shp As Shape
Dim Hoehe As Single
Dim Breite As Single

'Pfad = "G:\Bilder\"
Pfad = "C:\Test\"

'Alle Bilder im Blatt löschen
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Picture" Then shp.Delete
Next

'Spalte A ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Namen der Bilder stehen in Spalte A - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 1).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte B eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 2).Left, Cells(Wiederholungen, 2).Top, 85, 85
Else
'falls nein, wird in Spalte B eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 2) = "Bild nicht gefunden"
End If
Next

'Nun das Bild aus Spalte X einfügen
strDatnam = Pfad & ActiveSheet.Range("X1").Value & ".jpg" 'Name des Bildes
Hoehe = ActiveSheet.Range("X3").Value * 28.35 'Höhe des Bildes
Breite = ActiveSheet.Range("X4").Value * 28.35 'Breite des Bildes

'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte B eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, ActiveSheet.Range(ActiveSheet.Range("X2")).Left, ActiveSheet.Range(ActiveSheet.Range("X2")).Top, Breite, Hoehe
Else
'falls nein, wird in Zielzelle eine Fehlermeldung geschrieben
ActiveSheet.Range(ActiveSheet.Range("X2")) = "Bild nicht gefunden"
End If


End Sub


Gruß

M.O.
...