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.
|