PDA

Vollständige Version anzeigen : Mal wieder Bilder einfügen ...


binkoeln
12.07.2014, 13:33
Hallo Leute,
ich verzweifle grade (wahrscheinlich an meiner eigenen Blödheit!).
Ich habe folgendes Script (hoffe ich verstoße grade nicht gegen Forumsregeln!) hier aus dem Forum kopiert um damit Bilder aus einem Ordner in Excel einzufügen.


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 = "C:\Users\bjo\Pictures" '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



Allerdings wenn ich das Makro ausführe passiert nichts. Also im Sinne von Garnichts!
Ich kapier einfach nicht warum ...

Kann mir jemand helfen???
Vielen Dank im Voraus!


Im Editor sieht das ganze so aus(siehe Anhang) (vllt. hab ich´s an ner falschen Stelle abgelegt oder so...??.. keine Ahnung!)

Hajo_Zi
12.07.2014, 13:47
schaue doch mal hier Bilder einfügen (http://hajo-excel.de/inhalt_vba_bild.htm)

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

binkoeln
12.07.2014, 13:52
Hallo Hajo,
hab ich schonmal reingeschaut, hilft mir aber leider nicht wirklich weiter...

GMG-CC
12.07.2014, 19:54
Moin, setze mal zwischen die beiden Zeilen
strFile = Dir(cstrPath & IIf(Right(cstrPath, 1) = "\", "", "\") & .Cells(lngRow, 1) & cstrExtention, vbNormal)
If strFile <> "" Then
ein
MsgBox strFile
was kommt dabei heraus? Ansonsten den Code (ohne die MsgBox) schrittweise per F8 durchgehen und die Variablen durch darauf zeigen beobachten.