Bilder in Zellen einfügen

Forumthread: Bilder in Zellen einfügen

17.12.2013 07:33:45

Dikr

Hallo zusammen,
kurz vorab mir steht Office 2003 und 2010 zu verfügung.
Ich habe folgendes Problem:
In einer Tabelle habe ich in der Spalte F (ab Zeile 8 bis ca 700) verschiedene Namen stehen. Jeder Name steht für ein Bild/Symbol im jpg-Format.
Die Bilder/Symbole tragen alle den Namen GHS01 bis GHS09 und sind wenn mehrere Symbole benötigt werden mit ", " getrennt.
Wie bekomme ich es hin, den Text z.B. F8=GHS01, GHS08 F9=GHS07 ... durch die Bilddateien zu ersetzen.
Es können von 0 bis theoretisch 9 Bilder in einer Zelle benötigt werden.
Gruß
Dirk

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bilder in Zellen einfügen

17.12.2013 10:07:21

Beverly
AW: Bilder in Zellen einfügen

18.12.2013 10:00:17

Dirk
AW: Bilder in Zellen einfügen

18.12.2013 10:36:33

Beverly
AW: Bilder in Zellen einfügen

19.12.2013 07:27:13

Dirk
AW: Bilder in Zellen einfügen

19.12.2013 08:22:37

Beverly

AW: Bilder in Zellen einfügen

17.12.2013 10:07:21

Beverly

Hi Dirk,
wo sind die Bilder gespeichert - im Tabellenblatt oder auf der Festplatte?

AW: Bilder in Zellen einfügen

18.12.2013 10:00:17

Dirk

Hallo Karin,
die Bilder befinden sich auf der Festplatte.
Alle in einem Verzeichniss. Die Bildgröße ist 135x135 pixel.
Gruß
Dirk

AW: Bilder in Zellen einfügen

18.12.2013 10:36:33

Beverly

Hi Dirk,
versuche es mal auf diesem Weg:

Sub BilderEinfuegen()
Const strPfad As String = "D:\Test\"
Dim lngZeile As Long
Dim bytZaehler As Byte
Dim arrBilder
For lngZeile = 8 To IIf(IsEmpty(Cells(Rows.Count, 6)), _
Cells(Rows.Count, 6).End(xlUp).Row, Rows.Count)
If Cells(lngZeile, 6)  "" Then
If InStr(Cells(lngZeile, 6), ",") > 0 Then
arrBilder = Split(Cells(lngZeile, 6).Value, ",")
Else
ReDim arrBilder(0)
arrBilder(0) = Cells(lngZeile, 6)
End If
For bytZaehler = 0 To UBound(arrBilder)
If Dir(strPfad & arrBilder(bytZaehler) & ".jpg")  "" Then
ActiveSheet.Pictures.Insert (strPfad & arrBilder(bytZaehler) & ".jpg")
If bytZaehler = 0 Then
With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
.Top = Cells(lngZeile, 6).Top
.Left = Cells(lngZeile, 6).Left
.Height = Cells(lngZeile, 6).Height
End With
Else
With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
.Top = Cells(lngZeile, 6).Top
.Left = ActiveSheet.Pictures(ActiveSheet.Pictures.Count - 1).Left + _
ActiveSheet.Pictures(ActiveSheet.Pictures.Count - 1).Width
.Height = Cells(lngZeile, 6).Height
End With
End If
End If
Next bytZaehler
End If
Next lngZeile
End Sub

Den Speicherpfad der Bilder musst du natürlich deinen Bedingungen entsprechend ändern.
Das Anpassen der eingefügten Bilder an die Zeilenhöhe habe ich mal auskommentiert, das ich nicht weiß, ob du das benötigst.

AW: Bilder in Zellen einfügen

19.12.2013 07:27:13

Dirk

Hallo Karin,
Ich konnte das gerade mal ausprobieren. Sieht wirklich gut aus.
Ein kleines Problem gibt es aber, bei eigigen Symbolen verzerrt er die bildgröße.
Normale Bildgröße 108*108 pixel
nach einfügen 200*108 pixel (in die Breite gezogen)
kann man das kontrollieren?
Gruß
Dirk

AW: Bilder in Zellen einfügen

19.12.2013 08:22:37

Beverly

Hi Dirk,
ergänze jeweils for der Zeile .Top = .... diese Zeile

                     .ShapeRange.LockAspectRatio = msoTrue

Übrigens: in meinem vorhergehenden Beitrag hatte ich geschrieben, dass ich die Anpassung an die Zeilenhöhe auskommentiert habe. Das stimmt natürlich nicht - hatte beim Code nachträglich die Zeilenumbrüche eingefügt und ihn dann noch einmal in den Beitrag kopiert und dabei vergessen die betreffenden Zeilen auszukommentieren. Falls du das noch machen willst: es sind jeweils die Zeilen .Height = ...

Beliebteste Forumthreads (12 Monate)

Forumthread: Bilder in Zellen einfügen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread