Office: Excel 2003

Hallo zusammen

Ich komme einfach nicht weiter.

Bei meiner Excel Tabelle möchte ich per VBA Bilder einfügen passend zur Art. Nr. und diese an der Höhe der Zeile anpassen. Das Aspect Ratio des Bildes darf sich dabei nicht ändern.

Meine Tabelle sieht wie folgt aus:

ScreenShot001.jpg

Die Bilder welche ich einfügen möchten heissen alle gleich wie die Art. Nr. nur mit .jpg als Datei. Die Bilder sind im Ordner C:\test\ gespeichert.

Habe schon einige Codebeispiele gefunden welche mir die Bilder importieren jedoch kam ich bei der Grössenanpassung nicht weiter.
Die Bilder wurde immer verzogen.

Hoffe Ihr könnt mir helfen.

Gruss Pilot23

:)

 

Hallo ???,

scheint schön langsam zur Seuche zu werden, hier Bilder statt ordentlicher Beispieltabellen einzustellen;-(((

Probier mal folgendes makro.

Sub insertPictures()
Dim objPic As Object
Dim lngRow As Long, lngLast As Long
Dim strFile As String

Const cstrPath As String = "E:\Temp" 'Pfad
Const cstrExtention As String = ".jpg"

With Sheets("Tabelle1") 'Tabellenname anpassen!
lngLast = Application.Max(3, .Cells(.Rows.Count, 1).End(xlUp).Row)
For lngRow = 3 To lngLast
If .Cells(lngRow, 1) <> "" Then
strFile = Dir(cstrPath & IIf(Right(cstrPath, 1) = "\", "", "\") & .Cells(lngRow, 1) & cstrExtention, vbNormal)
If strFile <> "" Then
Set objPic = .Pictures.Insert(cstrPath & IIf(Right(cstrPath, 1) = "\", "", "\") & strFile)
objPic.Top = .Cells(lngRow, 1).Top
objPic.Left = .Cells(lngRow, 6).Left
objPic.ShapeRange.LockAspectRatio = True
objPic.Height = .Cells(lngRow, 1).Height
End If
End If
Next
End With

Set objPic = Nothing
End Sub


Gruß Sepp

 

Hallo Sepp

Danke für das Makro, importieren tut es ohne Problem, auch werden die Bilder an der Zeile angepasst, jedoch in der Breite nicht - daher sind die Bilder anschliessend verzogen.

Im Code habe ich Code:

gesehn, welches doch genau dieses Problem beseitigen soll gefunden.
Hilft jedoch nicht.

Gruss Pilot23

 

Hallo ???,

tatsächlich scheint xl2003, im gegensatz zu xl2007, .LockAspectRatio zu ignorieren.

Na dann berechnen wir die Breite eben selber.

Sub insertPictures()
Dim objPic As Object
Dim lngRow As Long, lngLast As Long
Dim dblOHeight As Double, dblOWidth As Double
Dim strFile As String

Const cstrPath As String = "E:\Temp" 'Pfad
Const cstrExtention As String = ".jpg"

With Sheets("Tabelle1") 'Tabellenname anpassen!
lngLast = Application.Max(3, .Cells(.Rows.Count, 1).End(xlUp).Row)
For lngRow = 3 To lngLast
If .Cells(lngRow, 1) <> "" Then
strFile = Dir(cstrPath & IIf(Right(cstrPath, 1) = "\", "", "\") & .Cells(lngRow, 1) & cstrExtention, vbNormal)
If strFile <> "" Then
Set objPic = .Pictures.Insert(cstrPath & IIf(Right(cstrPath, 1) = "\", "", "\") & strFile)
objPic.Top = .Cells(lngRow, 1).Top
objPic.Left = .Cells(lngRow, 6).Left
dblOHeight = objPic.Height
dblOWidth = objPic.Width
objPic.ShapeRange.LockAspectRatio = False
objPic.Height = .Cells(lngRow, 1).Height
objPic.Width = dblOWidth * (objPic.Height / dblOHeight)
End If
End If
Next
End With

Set objPic = Nothing
End Sub


Gruß Sepp

 

Hallo Sepp

Nun hats bestens geklappt, danke vielmals für die Hilfe !

Gruss

 

Hallo,

genau so ein Makro habe ich gesucht, funktioniert super soweit. Wenn die Bilder aber in das Dokument eingebettet werden sollen und nicht nur verknüpft, geht das auch mit diesem Makro?
Wo kann diese Option adressiert werden? Oder gibt es eine andere Möglichkeit, die als Verknüpfung geladenen Bilder in das Dokument automatisiert einzubetten?

Gruss, macoff

PS: Wie man liest habe ich keine Ahnung von Makros, aber vielleicht kann mir jemand hier weiterhelfen. Bitte.

 

einige Beispiele zu Bild einfügen.
Bild einfügen