Office: Bild einfügen und drucken

Hallo,

ich habe eine Tabelle (Artikel) und ein Verzeichnis Artikelbilder. Wie kann ich Artikel aus der Artikeltabelle mit dem dazugehörigen Bild drucken?
Artikelname(A1) = Bildname
Hat jemand einen Tipp für mich???
(Excel2003)

Danke
gasaffe

 

Hallo gasaffe,

was genau möchtest Du erreichen?
Mit "LoadPicture" könnte man ein Bild in eine UserForm laden, und diese dann ausdrucken.
Oder hast Du ein Tabellenblatt als Vorlage vorbereitet, in welches dann alle gewünschten Daten, und auch das Bild eingefügt werden sollen, um dann alles zu drucken?
Oder willst Du einfach nur eine Bilddatei auswählen und ausdrucken?

Beschreibe bitte mal möglichst genau was Du vorhast, am besten mit einer möglichst vollständigen Beispieldatei.

 

Hallo,

ich habe mich wohl nicht so deutlich ausgedrückt.

Ich möchte in Spalte C das Bild einfügen, das unter dem Namen in Spalte B in einem Bilderordner gespeichert ist, ohne jedes einzeln einfügen zu müssen.

Keine Ahnung, wie ich hier Dateien hochladen kann, sorry.

Gruß
gasaffe

 

Hallo gasaffe,

Dateien kannst Du folgt hochladen:
- scrolle runter zum Antwortfenster
- klicke darunter auf "Erweitert"
- scrolle in der neuen Seite wieder runter, bis Du unterhalb des Eingabefensters bist und suche den Button "Anhänge verwalten"

der Rest sollte eigentlich selbsterklärend sein...

 

hier nun meine Testdatei

 

Hallo gasaffe,

mit einer Beispieldatei ist die Hilfe direkt einfacher.
Im Modul des Tabellenblattes hast Du ja bereits eine Ereignisprozedur.
Auf die konnte ich nun schön aufbauen.

Ersetze Deinen Code durch den folgenden:

Code:

Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim dblFaktor As Double
Dim strPfad As String
Dim objBild As Object

    With Me
        If Target.Column = 2 Then
            strPfad = ThisWorkbook.Path & "\Artikelfotos\" & Target & ".jpg"
            If Dir(strPfad) = "" Then
                MsgBox "kein Foto vorhanden"
            ElseIf .Cells(Target.Row, 3) = "" Then
                Set objBild = .Pictures.Insert(strPfad)
                With objBild
                    dblFaktor = .Height / .Width
                    .Top = Me.Cells(Target.Row, 3).Top + 2
                    .Left = Me.Cells(Target.Row, 3).Left + 2
                    .Height = Me.Cells(Target.Row, 3).Height - 4
                    If .Width > (Me.Cells(Target.Row, 3).Width - 4) Then
                        .Width = Me.Cells(Target.Row, 3).Width - 4
                        .Height = .Width * dblFaktor
                    End If
                End With
                Set objBild = Nothing
                .Cells(Target.Row, 3) = Target & ".jpg"
            ElseIf Not .Cells(Target.Row, 3) = "" Then
                ActiveWorkbook.FollowHyperlink strPfad
            End If
        End If
    End With
    
End Sub

Wenn Du nun in der Tabelle einen Doppleklick in einer Zelle machst, wird geprüft ob die Zelle in Spalte 2 liegt.

Wenn ja, wird geprüft ob das entsprechende Foto am angegebenen Speicherort vorhanden ist.
​

Wenn ja, wird geprüft ob in der gleichen Zeile die Zelle in Spalte 3 einen Wert hat.
​

Wenn nein, wird das entsprechende Foto eingefügt, und der Fotoname in Spalte 3 eingetragen.
Wenn ja, wird das entsprechende Foto mittels Standardbrowser geöffnet und angezeigt.​

Wenn nein, erscheint Deine MsgBox "kein Foto vorhanden".​

Die Prüfung, ob in der Spalte 3 ein Zellwert eingetragen wurde, bzw. der Eintrag dieses Zellwertes soll verhindern, dass jedesmal ein Foto eingefügt wird. Denn die würden sich übereinander stapeln ohne das Du es siehst, und so die Datei extrem und unnötig aufblähen.
Man könnte dies auch durch eine Abfrage verhindern, ob ein Bild mit entsprechendem Namen in diesem Blatt bereits existiert, aber das wäre etwas aufwändiger.

Damit Du die Bildnamen in Spalte 3 nicht siehst, kannst Du ja die Schriftfarbe auf "weiß" stellen.


Wichtig bei solchen Listen mit Bildern: die Bilder müssen kleiner als die Zellen sein, sie dürfen den Zellrand nicht berühren. Ansonsten werden sie z.Bsp. nicht mitsortiert und es gibt ein undurchschaubares Durcheinander.


Da die Bilder mittels Browser angezeigt werden wenn sie bereits in der Tabelle vorhanden sind, würde es sich anbieten, diese Funktion für eine Großansicht zu nutzen.
Dafür würde ich zwei Bilderordner erstellen: 1x alle Bilder in kleiner Auflösung zum einfügen in die Tabelle, und 1x alle Bilder in hoher Auflösung für die Großansicht.
Natürlich müsste im Code dann einer der Pfade entsprechend geändert werden.


Wenn Du etwas von dem Code nicht verstehst, frage ruhig nach, ich erkläre ihn Dir gerne.

Ich hoffe ich habe geholfen.

 

Hallo Achim,

das ist ja genial - danke für die viele Arbeit, die du dir gemacht hast.

Ich habe jetzt auch 2 Verzeichnisse mit Artikelbildern (einmal groß, einmal klein) - ich bin begeistert.

Aber eine Frage habe ich noch: Könnte ich die Artikelbilder auch automatisch einfügen lassen??? - meine Originaltabelle hat bisher 150 Datensätze.

Gruß Marion

 

Hallo Marion,

die Bilder automatisch in der ganzen Tabelle einzufügen ist auch kein Problem.
Dazu muss nur (mehr oder weniger) der Code in eine entsprechende Schleife gepackt werden.

Kopiere den folgenden Code in das Modul des Tabellenblattes, aber unterhalb des bisherigen Codes, ersetze den bisherigen nicht:

Code:

Private Sub Bilder_einfügen()

Dim loLastRow As Long
Dim loCounter As Long
Dim strPfad As String
Dim objBild As Object
Dim dblFaktor As Double
    
    With Me
        loLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
        For loCounter = 2 To loLastRow
            If Not .Cells(loCounter, 2) = "" Then
                strPfad = ThisWorkbook.Path & "\Artikelfotos\" & .Cells(loCounter, 2) & ".jpg"
                If Not Dir(strPfad) = "" And .Cells(loCounter, 3) = "" Then
                    Set objBild = .Pictures.Insert(strPfad)
                    With objBild
                        dblFaktor = .Height / .Width
                        .Top = Me.Cells(loCounter, 3).Top + 2
                        .Left = Me.Cells(loCounter, 3).Left + 2
                        .Height = Me.Cells(loCounter, 3).Height - 4
                        If .Width > (Me.Cells(loCounter, 3).Width - 4) Then
                            .Width = Me.Cells(loCounter, 3).Width - 4
                            .Height = .Width * dblFaktor
                        End If
                    End With
                    Set objBild = Nothing
                    .Cells(loCounter, 3) = .Cells(loCounter, 2) & ".jpg"
                End If
            End If
        Next loCounter
    End With

End Sub

Nun musst Du eventuell noch den Ordner in der folgenden Zeile anpassen:

Code:

strPfad = ThisWorkbook.Path & "\Artikelfotos\" & .Cells(loCounter, 2) & ".jpg"

Und nun starte diese Prozedur 1x manuell.

Solltest Du später nochmal eine größere Zahl von Bildern auf einen Rutsch einfügen wollen, starte diese Prozedur halt nochmal.
Auch hier wird wieder geprüft, ob in Spalte 3 ein Zellwert vorhanden ist. So werden später dann nur in Zeilen ohne Bilder welche eingefügt.

Voraussetzung ist natürlich, dass die Zellwerte in Spalte 3 nicht versehentlich gelöscht werden.
Eventuell wäre dafür ein entsprechender Blattschutz angebracht. Den müsste man dann aber in beiden Makros auch aufheben und nachher wieder setzen, ansonsten würden die Makros vor die Wand laufen.


Da Du Dich ja offensichtlich für die Großansicht der Bilder per Browser begeisterst, dies könnte man auch noch auf anderem Wege machen:
Die Bilder bildschirmfüllend über eine UserForm direkt in Excel anzeigen lassen.
Dies hätte den Vorteil, das kein externes Programm benötigt/gestartet werden muss, allerdings benötigt man dafür auch ein wenig API, und das kann, je nach Windows-Version, auch mal nicht funktionieren (bzw. müsste dann angepasst und umgeschrieben werden).
Falls Interesse bestehen sollte, den Code dafür habe, könnte ich Dir anpassen.


Ich hoffe geholfen zu haben.

 

Hallo Achim,

fast perfekt - alle Bilder sind nun eingefügt

- nur mit den Bildern habe ich jetzt noch ein Problem - sie sind alle unterschiedlich groß, d.h. die längere Seite ist eine feste Größe und die andere prozentual angepasst an das Originalbild. In meiner Tabelle sind von den eingefügten viele verzerrt - fast quadratisch. Bei den einen passt es ungefähr, die anderen sind sehr rechteckig gewesen.
Muss ich alle 150 Bilder bearbeiten, damit sie exakt gleich sind, oder kann man das beim Einfügen regeln???

Bin aber auch so schon überaus zufrieden.

Gruß Marion

 

Hallo Marion,

das Makro fügt die Bilder ein, und passt dann die Höhe der Bilder an die Höhe der Zelle an.
Auf meinem System verändert sich die Größe des Bildes dabei proportional, d.h. die Breite wird automatisch entsprechend mit geändert.
Nur wenn die Breite danach noch größer als die Breite der Spalte sein sollte, wird der Vorgang wiederholt, diesmal aber von der Breite ausgehend.

Verzerrt wird bei mir nichts, deshalb bin ich mir nicht sicher was genau Du meinst.
Vielleicht läuft es auf Deinem System aber auch etwas anders, dann müssten wir nachbessern.

Falls Du aber damit meinst, dass die Bilder in den Zellen nicht alle gleich groß sind, das könnte auch daran liegen, das die Bildquellen nicht alle gleich groß sind.
Hast Du die Bilder in einem Bildbearbeitungsprogramm beschnitten?

Ich habe Dir mal einen Screenshot angehängt, wie es bei mir aussieht.
Vielleicht machst Du das auch mal, damit ich einen besseren Eindruck bekomme, was genau Du meinst.

 

Hallo Achim,

ja, die Bilder sind nicht alle gleich groß - wobei sie die längere Seite immer gleich haben - egal, ob breit oder hoch. Es sieht so aus, als ob beim Einfügen die Breite bleibt und die Höhe hochgerechnet wird auf die Zellenhöhe



Gruß Marion

 

Hallo Marion,

okay, dann läufts auf verschiedenen Systemen unterschiedlich...

1. hatte ich einen Fehler in der Berechnung, der aber bisher garnicht zum tragen kam > ist jetzt beseitigt
2. wird jetzt nach der Höhe auch immer die Breite des Bildes entsprechend dem ursprünglichen Seitenverhältnis angepasst

Sry für die Umstände.


Lösche beide Makros aus dem Modul das Arbeitsblattes und füge den folgenden Code komplett ein:

Code:

Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim dblFaktor As Double
Dim strPfad As String
Dim objBild As Object

    With Me
        If Target.Column = 2 Then
            strPfad = ThisWorkbook.Path & "\Artikelfotos\" & Target & ".jpg"
            If Dir(strPfad) = "" Then
                MsgBox "kein Foto vorhanden"
            ElseIf .Cells(Target.Row, 3) = "" Then
                Set objBild = .Pictures.Insert(strPfad)
                With objBild
                    dblFaktor = .Width / .Height
                    .Top = Me.Cells(Target.Row, 3).Top + 2
                    .Left = Me.Cells(Target.Row, 3).Left + 2
                    .Height = Me.Cells(Target.Row, 3).Height - 4
                    .Width = .Height * dblFaktor
                    If .Width > (Me.Cells(Target.Row, 3).Width - 4) Then
                        .Width = Me.Cells(Target.Row, 3).Width - 4
                        .Height = .Width * (1 / dblFaktor)
                    End If
                End With
                Set objBild = Nothing
                .Cells(Target.Row, 3) = Target & ".jpg"
            ElseIf Not .Cells(Target.Row, 3) = "" Then
                ActiveWorkbook.FollowHyperlink strPfad
            End If
        End If
    End With
    
End Sub

Private Sub Bilder_einfügen()

Dim loLastRow As Long
Dim loCounter As Long
Dim strPfad As String
Dim objBild As Object
Dim dblFaktor As Double
    
    With Me
        loLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
        For loCounter = 2 To loLastRow
            If Not .Cells(loCounter, 2) = "" Then
                strPfad = ThisWorkbook.Path & "\Artikelfotos\" & .Cells(loCounter, 2) & ".jpg"
                If Not Dir(strPfad) = "" And .Cells(loCounter, 3) = "" Then
                    Set objBild = .Pictures.Insert(strPfad)
                    With objBild
                        dblFaktor = .Width / .Height
                        .Top = Me.Cells(loCounter, 3).Top + 2
                        .Left = Me.Cells(loCounter, 3).Left + 2
                        .Height = Me.Cells(loCounter, 3).Height - 4
                        .Width = .Height * dblFaktor
                        If .Width > (Me.Cells(loCounter, 3).Width - 4) Then
                            .Width = Me.Cells(loCounter, 3).Width - 4
                            .Height = .Width * (1 / dblFaktor)
                        End If
                    End With
                    Set objBild = Nothing
                    .Cells(loCounter, 3) = .Cells(loCounter, 2) & ".jpg"
                End If
            End If
        Next loCounter
    End With

End Sub

Private Sub Bilder_loeschen()

Dim loLastRow As Long
Dim objBild As Object

    With Me
        For Each objBild In .Shapes
            objBild.Delete
        Next objBild
        loLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 3)), .Cells(.Rows.Count, 3).End(xlUp).Row, .Rows.Count)
        .Range(.Cells(2, 3), .Cells(loLastRow, 3)).ClearContents
    End With

End Sub

Für den Fall, dass Du keine Kopie Deiner Datei ohne die Bilder hast, habe ich Dir noch ein drittes Makro geschrieben, welches die Bilder und Zellwerte löscht.

Jetzt sollte eigentlich alles klappen.

 

Hallo Achim, (mein Mann heißt übrigens auch so)

WOW, sage ich nur - du musst dich doch nicht für die Umstände entschuldigen - mir hast du super geholfen, das kann ich gar nicht wieder gutmachen.

Ich bin mit dem Thema Patchwork nähen bestens vertraut - wenn du da mal was wissen möchtest *grins*, ich helfe auch gern.

Kopien meiner Datei habe ich schon zu viele, da muss ich aufpassen, dass ich mit der richtigen weiterarbeite.

Vielen, vielen Dank
Marion