Moin erstmal,
zunächst einmal muss ich sagen, dass ich überhaupt kein Vorwissen von VBA habe. An meinem Praktikumsplatz ist nun aber ein Problem aufgetreten, das direkt mit VBA zu tun hat. Und zwar hat mein Vorgänger ein Excel-Makro geschrieben, dass die erste Zeile einer Tabelle abfragt, dann in bestimmten Ordnern nach Bildern mit dem gleichen Namen plus die Endung .jpg absucht, und diese dann in ein *.pdf-Dokument schreiben soll. Das Problem ist nun, dass die Bilder aus einem Ordner manchmal mit eingebaut werden, und manchmal nicht. Entscheidend hierbei ist außerdem, dass immer Bilder aus demselben Ordner fehlen, jedoch nicht mit einer von mir erkennbaren Systematik; sprich bei einem Durchlauf ist das Bild mit dabei und beim nächsten nicht mehr.
Der Ordner der davon immer betroffen ist, ist derjenige der als erstes abgefragt wird.
Ich poste einmal den Codeschnipsel der wahrscheinlich der entscheidende ist.
Danke im Voraus,
Jasper
If Exist(Worksheets(3).Cells(3, 1).Value & "\" & Worksheets(1).Cells(i, 1).Value & ".jpg") = True _
And Exist(Worksheets(3).Cells(4, 1).Value & "\" & Worksheets(1).Cells(i, 1).Value & ".jpg") = True _
And Exist(Worksheets(3).Cells(5, 1).Value & "\" & Worksheets(1).Cells(i, 1).Value & ".jpg") = True Then
Cells(45, 1).Select
ActiveSheet.Pictures.Insert(Worksheets(3).Cells(3, 1).Value & "\" & Worksheets(1).Cells(i, 1).Value & ".jpg").Select
Selection.Name = "Photo" & i
With Selection.ShapeRange
.Left = Cells(48, 1).Left
.Top = Cells(48, 1).Top
.Width = 450
End With
ActiveSheet.Pictures.Insert(Worksheets(3).Cells(4, 1).Value & "\" & Worksheets(1).Cells(i, 1).Value & ".jpg").Select
Selection.Name = "Sv" & i
With Selection.ShapeRange
.Left = Cells(98, 1).Left
.Top = Cells(98, 1).Top
.Width = 450
End With
ActiveSheet.Pictures.Insert(Worksheets(3).Cells(5, 1).Value & "\" & Worksheets(1).Cells(i, 1).Value & ".jpg").Select
Selection.Name = "Ana" & i
ActiveSheet.Shapes.Range(Array("Ana" & i)).Select
Selection.ShapeRange.IncrementRotation 270
With Selection.ShapeRange
.Width = 584
.Left = Cells(151, 1).Left
.Top = Cells(160, 1).Top
End With
Selection.ShapeRange.IncrementLeft -100
PS: Ich verwende eine Beta von Office 2010 Pro |