Grafiken in Excel-Datei

14/04/2010 - 11:25 von Dietmar | Report spam
Hallo,

habe eine Liste aus Artikelnummer, Artikelbezeichnung und einen Pfad,
welcher auf die Abbildung verweist.
Bsp:
4711 | Kinderfahrrad rot | d:\bilder\kinderfahrrad4711.jpg
4712 | Kinderfahrrad blau | d:\bilder\kinderfahrrad4712.jpg

Daraus soll eine Excel-Datei erstellt werden mit den Spalten Artikelnummer,
Artikelbezeichnung und Abbildung. Also nicht mehr der Pfad auf die Abbildung
sondern die Abbildung selbst.

Wie mache ich das am besten?

Vielen Dank im voraus
Dietmar
 

Lesen sie die antworten

#1 Peter Schleif
14/04/2010 - 12:30 | Warnen spam
Dietmar schrieb am 14.Apr.2010 11:25 Uhr:

habe eine Liste aus Artikelnummer, Artikelbezeichnung und einen Pfad,
welcher auf die Abbildung verweist.
Bsp:
4711 | Kinderfahrrad rot | d:\bilder\kinderfahrrad4711.jpg
4712 | Kinderfahrrad blau | d:\bilder\kinderfahrrad4712.jpg

Daraus soll eine Excel-Datei erstellt werden mit den Spalten Artikelnummer,
Artikelbezeichnung und Abbildung. Also nicht mehr der Pfad auf die Abbildung
sondern die Abbildung selbst.

Wie mache ich das am besten?



Versuche es mal mit dem Code unten. Den Pfad zur Liste bitte anpassen.

Const LISTE = "T:\test\liste.txt"

Peter


Sub BilderEinfuegen()
Dim zelle As Range
Dim arr As Variant
Dim fso As Object

Const LISTE = "T:\test\liste.txt"

Set zelle = [A2]
Set fso = CreateObject("Scripting.FileSystemObject")

[A1:C1] = Array("Artikelnummer", "Artikelbezeichnung", "Abbildung")
[A1:C1].EntireColumn.AutoFit

With fso.OpenTextFile(LISTE, 1)
While Not .AtEndOfStream
arr = Split(.ReadLine, "|")
If UBound(arr) = 2 Then
zelle.EntireRow.VerticalAlignment = xlVAlignCenter
zelle = Trim(arr(0))
zelle.Offset(, 1) = Trim(arr(1))
If Not fso.FileExists(Trim(arr(2))) Then
zelle.Offset(, 2) = "Kein Bild"
Else
zelle.Offset(, 2).Select
With ActiveSheet.Pictures.Insert(Trim(arr(2)))
.ShapeRange.LockAspectRatio = msoTrue
ActiveCell.EntireRow.RowHeight = .ShapeRange.Height
If .ShapeRange.Width * 13 / 72 > _
ActiveCell.EntireColumn.ColumnWidth Then
ActiveCell.EntireColumn.ColumnWidth = _
.ShapeRange.Width * 13 / 72
End If
End With
End If
Set zelle = zelle.Offset(1)
End If
Wend
End With
zelle.Select
zelle.Resize(, 2).EntireColumn.AutoFit
End Sub

Ähnliche fragen