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,

das Bild, das hier im Beispiel mit 10 cm x 10 cm eingefügt werden soll, muss natürlich im selben Verzeichnis liegen, wie die anderen Bilder.

Gruß

M.O.
0 Punkte
Beantwortet von
Wahnsinn! Superklasse!

Nur das mit dem alle Bilder löschen funktioniert nur mit:

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

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

... werden lediglich neue Bilder eingelesen, die vorherigen aber nicht gelöscht...
und nun?

Geht das ganze auch ohne Knopf ... indem z.B. in einer bestimmten Zelle eine Artikelnummer steht und mit einer neuen Artikelnummer dann die Bilder automatisch komplett gelöscht und dann entsprechend neu eingelesen ?

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

das könnte mit dem Namen zusammenhängen, mit dem die Bilder eingefügt werden.
Ersetze mal
'Alle Bilder im Blatt löschen
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Picture" Then shp.Delete
Next

durch
'Alle Bilder im Blatt löschen
For Each shp In ActiveSheet.Shapes
If InStr(1, shp.Name, "Button") = 0 Then shp.Delete
Next


Gruß

M.O.
0 Punkte
Beantwortet von
Vielen Dank! Sitzenklasse!
0 Punkte
Beantwortet von
Hallo,

ich habe bei folgendem Code das Problem, dass die Bilder nicht mehr korrekt in die Zelle "gelegt" werden, sondern verrutschen. Was kann ich hier nun tun?

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim shp As Shape
Dim Hoehe As Single
Dim Breite As Single

On Error Resume Next

Pfad = "G:\Bilder\"

'Alle vorhandenen Bilder im aktiven Blatt löschen
'For Each shp In ActiveSheet.Shapes
'shp.Delete
'Next
'Alle Bilder im Blatt löschen
For Each shp In ActiveSheet.Shapes
  If InStr(1, shp.Name, "Button") = 0 Then 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
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

was meinst du mit verrutschen?

Bei mir werden die Bilder korrekt in die Spalte E eingefügt.

Gruß

M.O.
0 Punkte
Beantwortet von

es scheint als "verrutscht" das Bild mit jeder Zeile mehr...

Anfangs fällt es nicht auf, aber nach schon nach 50 Zeilen sieht es aus wie im Bild.

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

Hallo,

ich habe das Makro mal so umgeschrieben, dass die Bildhöhe an die Zeilenhöhe angepasst wird. Das Bild wird skaliert eingefügt und zwischen den Bildern wird noch etwas Platz gelassen (das kannst du aber ändern, wenn du willst).

Schau mal, ob es mit dem folgenden Makro nun besser aussieht:

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim shp As Shape
Dim Hoehe As Single
Dim Bildbreite As Long
Dim Bildhöhe As Long
Dim meinBild

On Error Resume Next

Pfad = "G:\Bilder\"

'Alle Bilder im Blatt löschen
For Each shp In ActiveSheet.Shapes
  If InStr(1, shp.Name, "Button") = 0 Then shp.Delete
Next

'Spalte E ab Zeile 7 durchlaufen
For Wiederholungen = 7 To ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
    'Namen der Bilder stehen in Spalte E - 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
       'Hoehe der Einfügezeile ermitteln - und zwei subtrahieren, damit zwischen den Bildern noch etwas Abstand ist - ggf. anpassen
       Hoehe = Cells(Wiederholungen, 5).Height - 2
       'Höhe und Breite des einzulesenden Bildes ermitteln
       Set meinBild = LoadPicture(strDatnam)
       Bildbreite = meinBild.Width
       Bildhoehe = meinBild.Height
       'Bilder werden in Spalte E eingefügt, Höhe entsprechend der Zeilenhöhe, Breite skaliert
       ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 5).Left, Cells(Wiederholungen, 5).Top, Hoehe * Bildbreite / Bildhoehe, Hoehe
    End If
Next Wiederholungen

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von
Hallo,

danke für den schnellen neuen Ansatz. Leider ist das Resultat das gleiche, lediglich sind die Bilder 2 kleiner.

Wie lautet der Befehl wo man den Abstand von der Oberkante individuell festlegen kann?

Sinngemäß: "Top of Cell + X", sodas jedes Bild etwas tiefer kommt...?!

Bin ratlos.

Danke & Gruß

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

Hallo TausH

du kannst den Abstand zur Oberkante wie folgt ändern:

ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 5).Left, Cells(Wiederholungen, 5).Top + 3, Hoehe * Bildbreite / Bildhoehe, Hoehe
   

Allerdings verschiebt sich das Bild dann natürlich nach unten.

Ich habe meinen oben geposteten Code jetzt mal mit rund 200 Bildern getestet. Bei mir werden die Bilder ensprechend der Zeilenhöhe eingefügt und es kommt zu keinen Verschiebungen. Warum das bei dir so ist, kann ich von hier aus nicht beurteilen.

Gruß

M.O.

...