Bilder in Excel automatisch einfügen

[DaliaSin]

Ich bin schon schier am Verzweifeln. Ich habe eine umfangreiche Excel-Tabelle mit vielen eingebundenen Bildern. Mittlerweile ist die Tabelle
bereits >50 MB und nicht mehr perfomant. :s

Jetzt hatte ich gedacht mit einem Makro würde es funktionieren die Bilder automatisch anhand der ID einzufügen pro Spalte. Da ich immer wieder
neue Datensätze bekomme und ich die grafiken immer per hand reinkopiere. Was echt mühsam ist.
Die direkte Ansicht brauche ich um alles gleich zuordnen zu können.

Zuerst habe ich an Kommentar gedacht. Aber da pflege ich ja auch wieder von Hand.

Dann hab ich mal ein bisschen mit Marko rumprobiert aber bis auf die Fehlermeldung "kein Bild gefunden" passiert nichts. ICh weis nicht woran es liegt. :(
Ist hier ein Makro Spezialist der mir evtl. helfen kann?

Hier mal das was ich jetzt seit stunden versuche um es zum laufen zu bringen.

Code:

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim Bildbreite As Single
Dim Bildhöhe As Single
Dim meinBild
Dim maxSpaltenbreite As Single
Dim Bild As Shape
Dim Zelle As Range

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad anpassen
Pfad = "C:\Users\PC\Desktop\AM-Web-Office\Bilder\"
'Spalte B ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'Namen der Bilder stehen in Spalte B - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 4).Value
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
 'falls ja, dann Bildhöhe und -breite einlesen
 Set meinBild = LoadPicture(strDatnam)
 Bildbreite = meinBild.Width
 Bildhoehe = meinBild.Height

 'Bild einfügen, 9 cm hoch - 1 cm = 28,35 pt - und Breite entsprechend skaliert
 ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 1).Left, Cells(Wiederholungen, 1).Top, 255.15 * Bildbreite / Bildhoehe, 255.15
 'maximale Spaltenbreite ermitteln, für die Anpassung der Spaltenbreite
 If maxSpaltenbreite < 255.15 * Bildbreite / Bildhoehe Then maxSpaltenbreite = 255.15 * Bildbreite / Bildhoehe
 Else
 'falls nein, wird in Spalte A eine Fehlermeldung geschrieben
 ActiveSheet.Cells(Wiederholungen, 1) = "Bild nicht gefunden"
End If
Next

'Zeilenhöhe anpassen
Rows("2:" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).RowHeight = 259

'Spaltenbreite anpassen
Columns("A:A").ColumnWidth = (WorksheetFunction.RoundUp(maxSpaltenbreite / 5, 0) + 2)

'Alle Bilder im Blatt in Zelle zentrieren
For Each Bild In ActiveSheet.Shapes
         
With Bild.TopLeftCell
  Set Zelle = Cells(.Row, .Column)
End With
   
Bild.Top = Zelle.Top + (Zelle.Height - Bild.Height) / 2
Bild.Left = Zelle.Left + (Zelle.Width - Bild.Width) / 2
           
Next

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub


Jemand ne Idee wo es nicht passt.

[Kuwer]

Hallo,

'Namen der Bilder stehen in Spalte B - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 4).Value           '<< Falsch
strDatnam = Pfad & Cells(Wiederholungen, 2).Value & ".jpg"  '<< Richtig

Gruß Uwe

[RPP63]

Moin!
Schon mal vorab Sorry!

Mittlerweile ist die Tabelle bereits >50 MB und nicht mehr perfomant

Herzlichen Glückwunsch!
Zwei Varianten:
Entweder Du haust noch ein paar Videos (Full HD, Kinolänge) rein oder Du nutzt Hyperlinks.
Oder dienen die Pixel der Bilder als Berechnungsgrundlage?

(und Ja! Ist Dein erster Beitrag, ändert aber nichts an meiner Einschätzung)

Gruß Ralf

[freddy]

Servus hier mal ein Ansatz
Musst halt den Pfad Anpassen wo die Bilder Hinterlegt sind und auch das Bild Format wie Bmp Jpeg usw.

Code:

  With ActiveSheet
 
For i = 1 To 9 '
 
On Error GoTo errorhandler

If Not IsEmpty(.Cells(i + 2, 4)) Then

               .OLEObjects("Image" & CStr(i)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & .Cells(i + 2, 4).Value & ".bmp")
               
               .OLEObjects("Image" & CStr(i + 9)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & .Cells(i + 2, 5).Value & ".bmp")
                 
                Else:
               
               .OLEObjects("Image" & CStr(i)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & "1.DFL Bundesliga.bmp")
                 
               .OLEObjects("Image" & CStr(i + 9)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & "1.DFL Bundesliga.bmp")
End If

[DaliaSin]

Hallo,

'Namen der Bilder stehen in Spalte B - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 4).Value           '<< Falsch
strDatnam = Pfad & Cells(Wiederholungen, 2).Value & ".jpg"  '<< Richtig

Gruß Uwe

Hallo Uwe. Ohje, jetzt wo du des schreibst fällt es mir auf. Hab wohl den Wald vor lauter Bäumen nicht gesehn. Vielen Dank auch.
Jetzt hat es auch gefunzt. Nur die größen passen überhaupt net.
Da muss ich wohl noch rum probieren.

LG

[DaliaSin]

Moin!
Schon mal vorab Sorry!

Herzlichen Glückwunsch!
Zwei Varianten:
Entweder Du haust noch ein paar Videos (Full HD, Kinolänge) rein oder Du nutzt Hyperlinks.
Oder dienen die Pixel der Bilder als Berechnungsgrundlage?

(und Ja! Ist Dein erster Beitrag, ändert aber nichts an meiner Einschätzung)

Gruß Ralf

Hallo Ralf,
danke schon mal für dein Sorry vorab.

Leider verstehe ich deinen Eintrag so gar nicht. Soll mir der Helfen???

Wie du schon schreibst, ja mein erster Beitrag. Sprich, ich habe auch null Ahnung mit Thema VB oder sonstiges.
Ich mache jetzt einfach seit langem diese Excel Liste und dachte mir ich könnte ja einiges verbessern daran.
Da eben diese Liste nicht mehr ganz so User-Freundlich ist und sehr langsam. Ich denke das liegt an den Bildern. Oder ist das nicht so?

Also durchforste ich Foren um mich selbst einzulesen und was zu probieren und nicht alles von jemand anderen vorgekaut zu bekommen.
Man will ja dazu lernen.


Jetzt kommt da so ne Antwort wo mir so gar nicht weiterhilft. So was schüchtert auch ziemlich ein. Vor allem, so mädels wie mich, die
sich in fremde Gefilde befindet.

LG

[DaliaSin]

Servus hier mal ein Ansatz
Musst halt den Pfad Anpassen wo die Bilder Hinterlegt sind und auch das Bild Format wie Bmp Jpeg usw.

Code:

  With ActiveSheet
 
For i = 1 To 9 '
 
On Error GoTo errorhandler

If Not IsEmpty(.Cells(i + 2, 4)) Then

               .OLEObjects("Image" & CStr(i)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & .Cells(i + 2, 4).Value & ".bmp")
               
               .OLEObjects("Image" & CStr(i + 9)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & .Cells(i + 2, 5).Value & ".bmp")
                 
                Else:
               
               .OLEObjects("Image" & CStr(i)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & "1.DFL Bundesliga.bmp")
                 
               .OLEObjects("Image" & CStr(i + 9)).Object.Picture = _
                LoadPicture(ThisWorkbook.Path & "\LOGOS\Bundesliga Vereinswappen\" & "1.DFL Bundesliga.bmp")
End If

Hallo freddy,

Vielen Dank für deine Hilfe.
Aber da muss ich mich erst mal schlau machen was das die schleife genau macht.
Bis jetzt sagt mein Debugger auch Fehler beim Kompilieren.

[Kuwer]

Hallo Dalia,

füge mal am Anfang des Makros noch eine Zeile ein (rot markiert):

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

ActiveSheet.DrawingObjects.Delete

'Pfad anpassen

Damit werden erst einmal alle Bilder entfernt.

Gruß Uwe

[RPP63]

Da eben diese Liste nicht mehr ganz so User-Freundlich ist und sehr langsam. Ich denke das liegt an den Bildern. Oder ist das nicht so?

Moin Dalia!
Ich wollte Dich nicht einschüchtern, sondern Dir meine Einschätzung kundtun.
Excel ist nun mal zunächst eine Kalkulation.
Das Problem ist, dass beim Öffnen der Datei zunächst mal alles in den Arbeitsspeicher geladen wird.
Auch wenn die Rechner immer schneller werden und der Arbeitsspeicher immer größer, heißt das imo nicht, dass man Excel vergewaltigen sollte.
Was Du erstellen willst/musst, ist eine Datenbank mit Bildern.
Dazu ist Excel nur eingeschränkt (wie Du bemerkt hast) geeignet.
Deshalb mein Tipp

• nutze eine "richtige" (relationale) Datenbank
  
• nutze eine Bilddatenbank wie z.B. das kostenlose IrfanView
  
• wenn Excel, dann nutze Hyperlinks oder verknüpfe, statt einzufügen
  

(Auch, wenn Du mit Uwes Tipps die Kiste lauffähig machen wirst, auf Dauer glücklich wirst Du damit nicht!)

Gruß Ralf

[Storax]

Irfanview ist ein Bildbetrachter, ein sehr guter IMHO, aber mehr nicht
Hier gibt es Links zu Anwendungen, die eher in die Richtung Bildverwaltung gehen

Und ansonsten hat Ralf Recht, mit Excel Bilder auf diese Art zu verwalten, wird Dich nicht glücklich machen.