Here's some code from an application that is inserting logos into headers of
documents and resizing them to the available space. You should get the idea
of how to do it from this:
'Insert Logo on Title Page
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.Delete
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Adjust size of logo to match avalable space
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight < InchesToPoints(2) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.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).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If owidth > InchesToPoints(2.85) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.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).Range.Tables(1).Cell(1,
1).Range.Delete
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight > InchesToPoints(0.68) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.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).Range.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).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If owidth > InchesToPoints(0.98) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.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).Range.Tables(1).Cell(1,
1).Range.Delete
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight > InchesToPoints(0.68) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
End If
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.
Doug Robbins - Word MVP