Makro läuft nicht "rund"

Public Sub prcInsertPicture()
' Legt das Dateiverzeichnis der Artikelbilder fest
Const strPath = "\\PFAD\"
' Definiert die Variablen Zeile (Row), SpalteArtNr (columnartnr), SpalteNild (ColumnPic),  _
Bildobjekt (object) und einen Index
Dim lngRow As Long
Dim lngIndex As Long
Dim ArtNr As String
Dim intColumnArtNr As Integer
Dim intColumnPic As Integer
Dim objShape As Object
Dim Dateinamen As String
Dim Verzeichnis As String
' Weist den Variablen SpalteArtNr (Column) und SpaltePic und Index Startwerte zu. In diesen  _
Spalten wird die artikelnummer gesucht und das Bild platziert.
intColumnArtNr = 2
intColumnPic = 1
lngIndex = 27
' Löscht jedes Bild in der Arbeitsmappe
For Each objShape In ActiveSheet.Shapes
If objShape.Type = msoPicture Then objShape.Delete
Next
For Each Zelle In Range("A13:A8000").SpecialCells(xlCellTypeVisible)
ArtNr = Trim$(Cells(Zelle.Row, intColumnArtNr).Text)
Dateinamen = Left(ArtNr, 2) & "_" & Mid(ArtNr, 4, 4) & "_" & Right(ArtNr, 4)
Verzeichnis = Left(ArtNr, 2) & "\" & Left(ArtNr, 2) & "_" & Mid(ArtNr, 4, 2) & "\"
If ArtNr  "" Then
If Dir$(strPath & Verzeichnis & Dateinamen & "_100" & ".jpg", vbNormal)  "" Then ' _
Prüft die Existenz eines Artikelbilds auf dem oben definierten Verzeichnis
Set objShape = ActiveSheet.Pictures.Insert(strPath & Verzeichnis & Dateinamen &  _
"_100" & ".jpg") 'Fügt das Artikelbild in das aktive Tabellenblatt ein
'Definiert die Position/Ausrichtung sowie Größe des Bilds
With objShape
.Left = Cells(Zelle.Row, intColumnPic).Left
.Top = Cells(Zelle.Row, intColumnPic).Top
.ShapeRange.Width = Cells(Zelle.Row, intColumnPic).Height - 10
End With
ElseIf Dir$(strPath & Verzeichnis & Dateinamen & ".jpg", vbNormal)  "" Then ' Prü _
ft die Existenz eines Artikelbilds auf dem oben definierten Verzeichnis
Set objShape = ActiveSheet.Pictures.Insert(strPath & Verzeichnis & Dateinamen &  _
".jpg") 'Fügt das Artikelbild in das aktive Tabellenblatt ein
'Definiert die Position/Ausrichtung sowie Größe des Bilds
With objShape
.Left = Cells(Zelle.Row, intColumnPic).Left
.Top = Cells(Zelle.Row, intColumnPic).Top
.ShapeRange.Width = Cells(Zelle.Row, intColumnPic).Width
End With
End If
End If
Next
Set objShape = Nothing
For Each objShape In ActiveSheet.Shapes
If objShape.Type = msoPicture Then
objShape.OnAction = "Bild_aendern"
End If
Next
End Sub