Automate Logo change over for many docs

[Gavin]

Hi,

I'm wanting to write a script that will look at every .doc
and .dot file in a directory, & each subdirectory, and
replace the old logo image with a new one.

It needs to cater for several docs not having the logo
image as well.

I've included my code so far (all VBA within MS Word
(XP)). I don't know if it will be wrapped by this
newsgroup form..

Any advice?

Thanks,
Gavin

CODE:
__________________________________________________
Sub Logo()
' Macro by Gavin Amm
' ### YOU MUST SELECT THE IMAGE BEFORE RUNNING THE
MACRO!!! ###
If Selection.Type = wdSelectionShape Then
Call Logo1
Call Logo2
Else
MsgBox "Did you forget to select the image???",
vbInformation, "Derr"
End If
End Sub
Sub Logo1()
'
' Logo1 Macro
' Macro recorded 17 September 2004 by Gavin Amm
'
Selection.ShapeRange.Delete
Selection.InlineShapes.AddPicture FileName:= _
"W:\Templates\KSG\logos\KSG_LOGO--45-actual.jpg",
LinkToFile:=False, _
SaveWithDocument:=True
Selection.MoveLeft Unit:=wdCharacter, Count:=1,
Extend:=wdExtend
Selection.InlineShapes(1).ConvertToShape
End Sub
Sub Logo2()
'
' LogoAddition Macro
' Macro recorded 17 September 2004 by Gavin Amm
'
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
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.Rotation = 0#
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.Left = 70.55
Selection.ShapeRange.Top = 49.6
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionColumn
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
Selection.ShapeRange.Left = CentimetersToPoints(11.2)
Selection.ShapeRange.Top = CentimetersToPoints(-0.5)
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 = 3
Selection.ShapeRange.ZOrder 4
Selection.HomeKey Unit:=wdStory
End Sub

 

[Cindy M -WordMVP-]

Hi Gavin,

I'm wanting to write a script that will look at every .doc
and .dot file in a directory, & each subdirectory, and
replace the old logo image with a new one.

It needs to cater for several docs not having the logo
image as well.

I've included my code so far (all VBA within MS Word
(XP)). I don't know if it will be wrapped by this
newsgroup form..

Any advice?

Well, the first thing you need to do is get away from using
Selection and learn to use Word's object model. More
concretely, in this case it means working with Stories,
StoryRanges, Shapes and InlineShapes. Look these up in Word's
Help.

The second, very necessary aspect, is figuring out how you
can identify the logo, as there may well be additional
graphical objects in the files?

And thirdly, in order to loop through all the folders and
their files in a location you can use either the older DIR
function, or the newer FileSystemObject. Both are in the
general VB portion of the Office Help.

I think you'll find samples for many of these in articles on
the word.mvps.org site.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun
8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow
question or reply in the newsgroup and not by e-mail