Sub Bildseiten_Zaehlen()
Dim ishp As InlineShape, ftn As Footnote
Dim pgn As Long, oldpgn As Long, pgc As Long, pgcf As Long, gezaehlt As String, gezaehltf As String
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 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