For Next Schleife wird nicht bis zum Ende ausgefüh
27.02.2017 17:39:46
Brunner
ich wende mich an Euch, da ich bei dem Problem hänge und nicht feststellen kann, warum. Ich habe eine For To Next Anweisung im Makro, welches nicht bis zum Endwert ausgeführt wird.
Ich habe Bildmaterial in einem Verzeichnis, dass ich zu den jeweiligen Zeilen einfügen will.
Nun sind zumindest die ersten beiden Bilder nicht vorhanden. Hier springt die IF-Schleife auch _
richtig zum EndIf. Auch der Zähler i zählt auf 19 hoch. In diesem Durchgang wurde die Next _
Anweisung noch ausgeführt. In der darauf folgenden Schleife wird wiederum auf EndIf gesprungen, _
der Zähler zählt auf 20, aber es gibt keinen Rücksprung zur For-Anweisung, sondern die '
Sub wird beendet.
Hier nun der Code. Hoffe sehr, dass mir jemand sagen kann, wo der Denkfehler ist.
Sub bilder_in_A_von_hypertext_in_B()
Dim objShape As Object
Dim sPath As String
Dim i As Long
Dim dHeight As Double
' Application.ScreenUpdating = False
ActiveSheet.Pictures.Delete
Range("G18").Select
Range(Selection, Selection.End(xlDown)).Select
'Rows("18:18").Select
'Range(Selection, Selection.End(xlDown)).Select
Selection.RowHeight = 45
' ActiveSheet.Range("H:H").Rows.EntireRow.AutoFit
For i = 18 To Cells(Rows.Count, 9).End(xlUp).Row 'ich starte ab Zeile 18 'ggf ändern
sPath = Cells(12, 1).Value & Cells(i, 7).Value & ".jpg"
If Dir(sPath) "" Then
'If Dir(sPath) = "" Then
'i = i + 1
Set objShape = ActiveSheet.Pictures.Insert(sPath)
With objShape
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
If .ShapeRange.Width > .ShapeRange.Height Then
.ShapeRange.Width = Cells(i, 6).Width
Else
.ShapeRange.Height = Cells(i, i).Height
End If
End With
Cells(i, 1).Select
dHeight = objShape.Height
Selection.RowHeight = dHeight
Set objShape = Nothing
End If
Next i
'Cells.EntireRow.AutoFit
Application.ScreenUpdating = True
End Sub
'Vielen Dank schon im Voraus