Hallo DC,

die gute Nachricht zuerst. Ich hab den Bug gefunden und behoben. Der Fehler trat nur auf, wenn die Seitenzahl mindestens zweistellig ist. Ich hab immer nur mit 5 Seiten getestet, da konnte ich das nicht sehen. z.B. wurde die Seite 9 schon als gezählt gewertet, wenn durch vorherige Schleifen Bilder auf Seite 19 gefunden wurden. Wäre dir im Einzelschritt bestimmt auch aufgefallen. Einfach ein Semikolon vor und nach pgn in der Instr-Funktion und der Fehler ist behoben.

Probier nochmal den folgenden Code, der sollte jetzt richtig zählen, sonst fress ich nen Besen :-)

Sub Bildseiten_Zaehlen()
 
  Dim ishp As InlineShape, shp As Shape, ftn As Footnote
  Dim pgn As Long, oldpgn As Long, pgc As Long, pgcf As Long, gezaehlt As String, gezaehltf As String
   
  gezaehlt = ";"
  gezaehltf = ";"
   
  For Each ishp In ActiveDocument.InlineShapes
    oldpgn = pgn
    pgn = ishp.Range.Information(wdActiveEndPageNumber)
    If pgn > oldpgn Then
      gezaehlt = gezaehlt & pgn & ";"
      pgc = pgc + 1
      If ishp.PictureFormat.ColorType = msoPictureAutomatic Then
        gezaehltf = gezaehltf & pgn & ";"
        pgcf = pgcf + 1
      End If
    End If
  Next ishp
   
  pgn = 0
  For Each shp In ActiveDocument.Shapes
      oldpgn = pgn
      pgn = shp.Anchor.Information(wdActiveEndPageNumber)
      If pgn > oldpgn And InStr(1, gezaehlt, ";" & pgn & ";") = 0 Then
        gezaehlt = gezaehlt & pgn & ";"
        pgc = pgc + 1
      End If
      If pgn > oldpgn And shp.PictureFormat.ColorType = msoPictureAutomatic And InStr(1, gezaehltf, ";" & pgn & ";") = 0 Then
          gezaehltf = gezaehltf & pgn & ";"
          pgcf = pgcf + 1
      End If
  Next shp
   
    
  pgn = 0
  For Each ftn In ActiveDocument.Footnotes
    For Each ishp In ftn.Range.InlineShapes
      oldpgn = pgn
      pgn = ishp.Range.Information(wdActiveEndPageNumber)
      If pgn > oldpgn And InStr(1, gezaehlt, ";" & pgn & ";") = 0 Then
        gezaehlt = gezaehlt & pgn & ";"
        pgc = pgc + 1
      End If
      If pgn > oldpgn And ishp.PictureFormat.ColorType = msoPictureAutomatic And InStr(1, gezaehltf, ";" & pgn & ";") = 0 Then
          gezaehltf = gezaehltf & pgn & ";"
          pgcf = pgcf + 1
      End If
    Next ishp
  Next ftn
   
     MsgBox "Seiten mit Bildern: " & pgc _
& Chr(13) & "Seiten mit farbigen Bildern: " & pgcf
   
End Sub

PS: Hast du mal getestet ob es in deiner neueren Word-Version vielleicht doch möglich ist Bilder in Fussnoten frei zu platzieren? Ich hoffe nicht, sonst müssen wir den Code doch nochmal um Shapes in den Fussnoten erweitern.

Gruß Mr. K.