picture in a Word header

[Cor van der Bliek]

I want to put in a (named) picture in all headers of the active document when
a macro button is pushed. I managed to do so, but to my syprise the macro
results in an error when I moved the template with the macro(s) to the Word
startup folder.
Something about 'not having set an object variable or block variable With'.
How come a macro working fine outside the startupfolder, refuses to do its
duty within the folder and more important: how do I solve the problem.

Another macro should be able to get rid of all the pictures (more specific
the picture with a certain name) in all headers of the active document.
Who can help?

 

[Word Heretic]

G'day "Cor van der Bliek" <[email protected]>,

Are you using classes? What automacros are you using to instance your
objects? What are your entry points? What version of Word?

Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Cor van der Bliek reckoned:

 

[Cor van der Bliek]

Hi,
I don't know if I'm using classes. Word2000 Dutch. Here's the code, gotten
from a macro, which implements the picture and puts it on the exact place:

Sub Huisstijl_logo()
If Documents.Count >= 1 Then
Selection.HomeKey Unit:=wdStory
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.InlineShapes.AddPicture FileName:= _
"G:\Templates\wstmmm1.gif", LinkToFile:=False, _
SaveWithDocument:=True
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InlineShapes(1).ConvertToShape.Select
Selection.ShapeRange.Name = "logo"
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 = 83.35
Selection.ShapeRange.Width = 197.85
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(1.5)
Selection.ShapeRange.Top = CentimetersToPoints(1)
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 = wdWrapTight
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Application.WindowState = wdWindowStateNormal
ActiveWindow.WindowState = wdWindowStateNormal
Else
MsgBox "Er is geen actief document!"
End If
End Sub

 

[Word Heretic]

G'day "Cor van der Bliek" <[email protected]>,

Which line causes the problem or does the whole thing refuse to run?


Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Cor van der Bliek reckoned:

 

[Cor van der Bliek]

There's no line number mentioned.

G'day "Cor van der Bliek" <[email protected]>,

Which line causes the problem or does the whole thing refuse to run?


Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Cor van der Bliek reckoned:

 

[Word Heretic]

G'day "Cor van der Bliek" <[email protected]>,

is there a highlighted line when it fails?


Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Cor van der Bliek reckoned:

 

[Cor van der Bliek]

Joost Verdaasdonk supplied the solution in the Dutch forum www.helpmij.nl:

Const sPic As String = "C:\Documents and Settings\Admin\My Documents\My
Pictures\logo\hills.jpg"
'Const sPic As String = "G:\Templates\wstmmm1.gif" 'this one is yours!

Sub Logo()
Dim oSec As Word.Section
Dim oHead As Word.HeaderFooter
Dim oShape As Word.Shape
Dim iCnt As Integer
Dim sName As String

If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False

For Each oSec In ActiveDocument.Sections
If oSec.Index > 0 And oSec.Index <= ActiveDocument.Sections.Count Then
For Each oHead In oSec.Headers
Set oShape = oHead.Shapes.AddPicture(sPic)
With oShape
.Name = CStr("Pic" & iCnt)
.LockAspectRatio = msoTrue
.Height = 83.35
.Width = 197.85
.RelativeHorizontalPosition =
wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Left = CentimetersToPoints(1.5)
.Top = CentimetersToPoints(1)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.WrapFormat.DistanceTop = CentimetersToPoints(0)
.WrapFormat.DistanceBottom = CentimetersToPoints(0)
.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
.WrapFormat.Type = wdWrapTight
End With
iCnt = iCnt + 1
Next
End If
Next
Set oShape = Nothing
End Sub
-------------
The following Sub deletes the picture in any header in the document:
-------------
Sub DeleteLogo()
Dim oSec1 As Word.Section
Dim oHead1 As Word.HeaderFooter
Dim oShape1 As Word.Shape

If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False

For Each oSec1 In ActiveDocument.Sections
If oSec1.Index > 0 And oSec1.Index <= ActiveDocument.Sections.Count Then
For Each oHead1 In oSec1.Headers
For Each oShape1 In oHead1.Shapes
If Left(oShape1.Name, 3) = "Pic" Then
oShape1.Delete
End If
Next
Next
End If
Next
End Sub
--------------------------------------------------------------------------------