View Single Post
  #5   Report Post  
Doug Robbins - Word MVP
 
Posts: n/a
Default

You will need to modify the macro with some more specific code to handle the
graphics. There is no doubt however that it can be done. Here's a
procedure from a project that I created at one time that does that sort of
thing (it too however will need to be modifed for your situation):

Sub UpdateDocs()
myFile = Dir$(PathToUse & "*.doc")
While myFile ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
'Insert logo if the file has been selected
If InStr(txtLargeLogoPath, ":") 0 Then
If myDoc.Sections.Count 1 And Not myDoc.Name = "FRM-701.doc" Then
'Insert Logo on Title Page

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
' Adjust size of logo to match avalable space
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight InchesToPoints(2) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(2)
.Width = owidth * InchesToPoints(2) / oheight
End With
End If
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If owidth InchesToPoints(2.85) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Width = InchesToPoints(2.85)
.Height = oheight * InchesToPoints(2.85) / owidth
End With
End If
'Insert Logo into all the Headers in the Document
For i = 2 To myDoc.Sections.Count

myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight InchesToPoints(0.68) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
If oheight InchesToPoints(0.68) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
oheight =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If owidth InchesToPoints(0.98) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Width = InchesToPoints(0.98)
.Height = oheight * InchesToPoints(0.98) / owidth
End With
End If
Next i
Else
'Insert Logo into Section 1 Header

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight InchesToPoints(0.68) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
If UCase(myDoc.Name) = "FRM-701.DOC" Then 'Special Case
document
'Insert Logo into Section 2 Header

myDoc.Sections(2).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(2).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(2).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(2).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight InchesToPoints(0.68) Then
With
myDoc.Sections(2).Headers(wdHeaderFooterPrimary).R ange.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
End If
End If
End If
'Create Document Variables
myDoc.Variables("vissue").Value = 1
myDoc.Variables("vrevision").Value = 0
myDoc.Variables("vDocDate").Value = Format(vIssueDate, "MMMM dd, yyyy")
myDoc.Variables("vRevDate").Value = Format(vIssueDate, "MMM dd, yyyy")
myDoc.Variables("vreviewer").Value = txtReviewer
myDoc.Variables("vapprover").Value = txtApprover
myDoc.Variables("vcompanyname").Value = txtCompanyName
myDoc.Variables("vstreetaddress").Value = txtStreetAddress
myDoc.Variables("vcity").Value = txtCity
myDoc.Variables("vstateprovince").Value = comboProvinceorState.Value
myDoc.Variables("vcountry").Value = comboCountry.Value
myDoc.Variables("vpostcodezip").Value = txtPostalorZipCode
myDoc.Variables("vqualityreptitle").Value = txtQualityRepTitle
myDoc.Variables("vphone").Value = txtPhone
myDoc.Variables("vfax").Value = txtFax
myDoc.Variables("vmanagername").Value = txtSeniorManagerName
myDoc.Variables("vmanagertitle").Value = txtSeniorManagerTitle
myDoc.Variables("vqualityrepname").Value = txtQualityRepName
'Update the fields in the document to display the values inserted into the
variables
myDoc.Fields.Update
For i = 1 To myDoc.Sections.Count
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).R ange.Fields.Update
Next i
'Save and Close
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP
"dixie" wrote in message
...
Dont worry with the last message - found I had included two lines of text

in
the module. It does work with text replacements, unfortunately, it won't
work for me as it is not capable of replacing the graphic in the letter
head. Blast, I got so excited about that.

dixie

"dixie" wrote in message
...
Thanks Doug that does look promising. I followed the instructions

however
and created a global template with that code in it and now, when I go to
the first document in the folder I wish to do the universal substitution
in and select the macro, I just get an error message that says "Compile
error in hidden module: ThisDocument". I have read the help, but it

does
not! Have you any ideas?

dixie

"Doug Robbins - Word MVP" wrote in message
...
The macro in the article "Find & ReplaceAll on a batch of documents in
the
same folder" at:

http://word.mvps.org/FAQs/MacrosVBA/BatchFR.htm

could be modified to do what you want.
--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions

forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP
"dixie" wrote in message
...
I am doing a job where I need to copy a letter header into each of

about
100
letters which are mailmerge template documents for about 20 different
customers - all up about 2000 copy and pastes requiring opening each
document and deleting the current header and pasting the new one. I
have
tried to use IncludeText to do this and having the header in a file,

but
it
appears that the client must open each letter and refresh the link
before
they can get the header in the letter.

Is there a way of doing what I am trying to do without me doing this
mindless copy and paste operation which takes about 1 hour for each
client
and is totally boring and therefore prone to me making mistakes.

Can a simple little program be written that will take a lump of text

out
of
one document and just paste it into a series of documents or just

paste
the
contents of the clipboard into the top of a document?

Any suggestions please.

dixie