AW: Bilder auf diversen Blättern ändern
11.03.2009 13:49:46
Renee
Hi Eby,
1. Wirf diesen Code in ein allgemeines Modul, einer leeren Mappe:
Sub BildErsetzen()
Const cNewPic = "H:\Eigene Dateien\Eigene Bilder\Brain.gif"
Dim ws As Object
Dim objPic As Object
Dim iPicCnt As Integer
Dim vPosition
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Sheets
iPicCnt = 0
ReDim vPosition(ws.Pictures.Count, 2)
For Each objPic In ws.Pictures
iPicCnt = iPicCnt + 1
vPosition(iPicCnt, 1) = objPic.Top
vPosition(iPicCnt, 2) = objPic.Left
objPic.Delete
Next objPic
For iPicCnt = 1 To UBound(vPosition)
ws.Pictures.Insert cNewPic
Next iPicCnt
iPicCnt = 0
For Each objPic In ws.Pictures
iPicCnt = iPicCnt + 1
objPic.Top = vPosition(iPicCnt, 1)
objPic.Left = vPosition(iPicCnt, 2)
Next objPic
Next ws
Application.ScreenUpdating = True
End Sub
2. Ersetze ggf. die Zeile 1 durch deinen Pfad und das neue Bild.
3. Öffne einer der Mappen und lasse das Makro laufen.
Achtung: Es werden ALLE Bilder in der Mappe durch das neue Bild ersetzt! Keine Aussnahmen!
GreetZ Renée