How to delete pasted images via VBA?

[Thomas Sander]

hello,
i hope that's the right place for my question...

this is what we want: instead of adobe acrobat or something we use the
freeware-tool 'pdfcreator' (very recommended, <http://www.pdfcreator.de.vu>
;-)). sometimes we want to send emails with our firm logo on the print. on
page 1 this is another one than one page 2, 3, 4, etc.

we use a macro to past the header in the word document. looks like this:


Sub PDFerzeugen()
Selection.HomeKey Unit:=wdStory
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.InlineShapes.AddPicture FileName:= _
"Z:\logo.eps", _
LinkToFile:=False, SaveWithDocument:=True
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InlineShapes(1).ConvertToShape

'Page1
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 269.85
Selection.ShapeRange.Width = 30.05
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionPage
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionPage
Selection.ShapeRange.Left = CentimetersToPoints(20)
Selection.ShapeRange.Top = CentimetersToPoints(0)
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft =
CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.DistanceRight =
CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
Selection.Copy

'Page 2
If ActiveDocument.ComputeStatistics(wdStatisticPages) > 1 Then
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.Paste
Selection.ShapeRange.Left = CentimetersToPoints(20)
Selection.ShapeRange.Top = CentimetersToPoints(0)
End If

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

'Druck
ActivePrinter = "PDFCreator"
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=False, PrintToFile:=False,
PrintZoomColumn:=0, _
PrintZoomRow:=0, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0

End Sub


----

okay so far. for further editing we need to delete these images now. but
these images now have undefined names like image15, image16 etc.

well, is there a possibility to simpy delete the images pasted just now?
how is the code?

thanks in advance says
tom

 

[Anne Troy]

Thomas: Are you familiar with autotext? First, I suggest you run this code
to get your images. Then select them all and group them, using tools from
the Drawing toolbar. The select whatever you're creating here, and hit
Insert-Autotext and name it. Then, just use autotext to put the header in,
even if that is done with the macro. But it seems you should only have one
object now.
<-*-><-*-><-*-><-*-><-*-><-*-><-*-><-*->
Hope this helps!
Anne Troy (better known as Dreamboat)
Author: Dreamboat on Word
Email: Dreamboat*at*Piersontech.com
Web: www.TheOfficeExperts.com
<-*-><-*-><-*-><-*-><-*-><-*-><-*-><-*->

 

[Helmut Weber]

Hi Thomas,
just one of many possible ways:
Sub DelPic()
Dim oSct As Section
Dim oHdr As HeaderFooter
Dim oDcm As Document
Dim oShp As Shape
Set oDcm = ActiveDocument
For Each oSct In oDcm.Sections
For Each oHdr In oSct.Headers
For Each oShp In oHdr.Shapes
oShp.Delete
Next
Next
Next
End Sub
Deletes all shapes in all headers in all sections,
or did you want to delete only some specific images?

Besides that, your probably recorded code could be improved
in many ways. And I would suggest, not to insert an eps-image,
unless it is a really very small file.

Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98

 

[Thomas Sander]

Hi Helmut,

Deletes all shapes in all headers in all sections,
or did you want to delete only some specific images?

yes, I do ;-) only these images should be deleted that were pasted in
before. Not the whole header. Any advice?

Thank you,
Thomas

 

[Helmut Weber]

Hi Thomas,
I'm pretty sure, that Word does not record,
whether an image was pasted or not, as it is
with characters. However, a shaperange or a shape
may have a name. In fact, several shapes may have
the same name. So I would recommend, to give
an image a name when pasting it.
Like here in your code:
somewhat shortend
dim d as document
set d = activedocument
If d.ComputeStatistics(wdStatisticPages) > 1 Then
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.Paste
Selection.ShapeRange.Left = CentimetersToPoints(20)
Selection.ShapeRange.Top = CentimetersToPoints(0)
Selection.ShapeRange.Name = "pasted"
End If
To delete only those images pasted, check for the name.
Like this, which may be shortended:
For Each oSct In oDcm.Sections
For Each oHdr In oSct.Headers
For Each oShp In oHdr.Shapes
If oShp.Name = "DeleteMe2" Then
' Stop
oShp.Delete
End If
Next
Next
Next
Greetings from Bavaria, Germany
Helmut Weber, MVP WordBVA
"red.sys" & chr(64) & "t-online.de"
Word XP, Windows 2000

 

[Helmut Weber]

of course:
If oShp.Name = "pasted" Then
' Stop
oShp.Delete
End If
HW

 

[Thomas Sander]

of course:
If oShp.Name = "pasted" Then
' Stop
oShp.Delete
End If
HW

great. we had to change the name to different names for the first and
following pages but it works now. thanks a lot, helmut!

tom