G
Grayson Ferrantex
Hi there,
Problem: Word 2000 inserts the picture at the top of the last page, not at
the anchor point as
desired. And this does not happen (ie I get what I want) if the code is
stepped through (F8) versus run (F5). Works fine
in Word 2002.
Any ideas on how to anchor this shape in Word 2000?
Thanks in advance,
Gray
Public Sub ChangeSignature()
Debug.Assert False 'unit test
Dim strFile As String
Dim i As Integer
Dim objDoc As Document
Dim objNewShape As Shape
Dim objOrigShape As Shape
Dim objInLineShape As InlineShape
Dim blnShowSignature As Boolean
Dim objRange As Range
Dim blnAddSig As Boolean
Set objDoc = Me.ActiveWindow.Document
blnShowSignature = True
strFile = "C:\WorkGBB\Signature\GeorgeGoulding_256color.bmp"
' strFile = "C:\WorkGBB\Signature\Production_Preferred_256Color.bmp"
strFileName = Mid(strFile, InStrRev(strFile, "\") + 1)
For i = 1 To objDoc.Shapes.Count
If objDoc.Shapes.Item(i).AlternativeText <> vbNullString Then
'picture has alternative text
'assume that means it is a signature
Set objOrigShape = objDoc.Shapes.Item(i)
blnAddSig = True 'init, we'll change to false if find we already
have the sig next
If 0 = StrComp(objOrigShape.AlternativeText, strFileName,
vbTextCompare) Then
'already have this desired signature
'make it visible and we're done
objOrigShape.Visible = msoTrue
blnAddSig = False
Else 'no match on file name
If LCase(objOrigShape.AlternativeText) = "signature" Then
'legacy CP signature found
If 0 = StrComp(strFileName,
"Production_Preferred_256Color.bmp", vbTextCompare) Then
'we want CP signature if file name is
Production_Preferred_256Color.bmp
objOrigShape.Visible = msoTrue
blnAddSig = False
End If
End If 'legacy CP signature found or not
End If 'already have desired signature, or not
'at this point blnAddSig is known and initial signature is in
objOrigShape
If blnAddSig Then
Debug.Assert objDoc.Shapes.Count = 1
'If you don't want the picture where the insertion point is,
set up a
'Range object, and use that Range object instead of
Selection.
'rgf Use Anchor of orig sig, but setup range obj first which
needs to be initialized
'to any range before you can set the start and end
properties
Set objRange = ActiveDocument.Range 'any arbitrary range,
just need to init objRange
' objRange.Collapse wdCollapseEnd 'might be unnecessary
objRange.Start = objOrigShape.Anchor.Start
objRange.End = objOrigShape.Anchor.End
'Set objRange = objOrigShape.Anchor 'for some reason can't
assign anchor directly to anchor, hence start and end
'now have an anchor for the new sig = objRange
Set objNewShape =
ActiveDocument.Shapes.AddPicture(FileName:= _
strFile, LinkToFile:=False, _
SaveWithDocument:=True, Anchor:=objRange)
Debug.Assert objDoc.Shapes.Count = 2
With objNewShape
.AlternativeText = strFileName 'sig identified by file name
so can tell if already have correct one.
' .AutoShapeType = objOrigShape.AutoShapeType
.Height = objOrigShape.Height
.Left = objOrigShape.Left
.LockAnchor = objOrigShape.LockAnchor
.LockAspectRatio = objOrigShape.LockAspectRatio
' .PictureFormat = objOrigShape.PictureFormat
.RelativeHorizontalPosition =
objOrigShape.RelativeHorizontalPosition
.RelativeVerticalPosition =
objOrigShape.RelativeVerticalPosition
' .TextEffect = objOrigShape.TextEffect
' .TextFrame = objOrigShape.TextFrame
' .ThreeD = objOrigShape.ThreeD
.Top = objOrigShape.Top
'ro .Type = objOrigShape.Type
.Width = objOrigShape.Width
.WrapFormat.Type = objOrigShape.WrapFormat.Type 'This
does NOT make it 'behind text', ZOrder does
.ZOrder msoSendBehindText
'ro .ZOrderPosition = objOrigShape.ZOrderPosition
' .Anchor = objOrigShape.Anchor
End With
objNewShape.Visible = msoTrue
'now delete the old signature, or at least make it invisible
objOrigShape.Delete
Else 'don't add sig
'show the orig sig
objOrigShape.Visible = blnShowSignature
End If 'adding sig or not
End If 'found signature
Next 'i shape
End Sub
Problem: Word 2000 inserts the picture at the top of the last page, not at
the anchor point as
desired. And this does not happen (ie I get what I want) if the code is
stepped through (F8) versus run (F5). Works fine
in Word 2002.
Any ideas on how to anchor this shape in Word 2000?
Thanks in advance,
Gray
Public Sub ChangeSignature()
Debug.Assert False 'unit test
Dim strFile As String
Dim i As Integer
Dim objDoc As Document
Dim objNewShape As Shape
Dim objOrigShape As Shape
Dim objInLineShape As InlineShape
Dim blnShowSignature As Boolean
Dim objRange As Range
Dim blnAddSig As Boolean
Set objDoc = Me.ActiveWindow.Document
blnShowSignature = True
strFile = "C:\WorkGBB\Signature\GeorgeGoulding_256color.bmp"
' strFile = "C:\WorkGBB\Signature\Production_Preferred_256Color.bmp"
strFileName = Mid(strFile, InStrRev(strFile, "\") + 1)
For i = 1 To objDoc.Shapes.Count
If objDoc.Shapes.Item(i).AlternativeText <> vbNullString Then
'picture has alternative text
'assume that means it is a signature
Set objOrigShape = objDoc.Shapes.Item(i)
blnAddSig = True 'init, we'll change to false if find we already
have the sig next
If 0 = StrComp(objOrigShape.AlternativeText, strFileName,
vbTextCompare) Then
'already have this desired signature
'make it visible and we're done
objOrigShape.Visible = msoTrue
blnAddSig = False
Else 'no match on file name
If LCase(objOrigShape.AlternativeText) = "signature" Then
'legacy CP signature found
If 0 = StrComp(strFileName,
"Production_Preferred_256Color.bmp", vbTextCompare) Then
'we want CP signature if file name is
Production_Preferred_256Color.bmp
objOrigShape.Visible = msoTrue
blnAddSig = False
End If
End If 'legacy CP signature found or not
End If 'already have desired signature, or not
'at this point blnAddSig is known and initial signature is in
objOrigShape
If blnAddSig Then
Debug.Assert objDoc.Shapes.Count = 1
'If you don't want the picture where the insertion point is,
set up a
'Range object, and use that Range object instead of
Selection.
'rgf Use Anchor of orig sig, but setup range obj first which
needs to be initialized
'to any range before you can set the start and end
properties
Set objRange = ActiveDocument.Range 'any arbitrary range,
just need to init objRange
' objRange.Collapse wdCollapseEnd 'might be unnecessary
objRange.Start = objOrigShape.Anchor.Start
objRange.End = objOrigShape.Anchor.End
'Set objRange = objOrigShape.Anchor 'for some reason can't
assign anchor directly to anchor, hence start and end
'now have an anchor for the new sig = objRange
Set objNewShape =
ActiveDocument.Shapes.AddPicture(FileName:= _
strFile, LinkToFile:=False, _
SaveWithDocument:=True, Anchor:=objRange)
Debug.Assert objDoc.Shapes.Count = 2
With objNewShape
.AlternativeText = strFileName 'sig identified by file name
so can tell if already have correct one.
' .AutoShapeType = objOrigShape.AutoShapeType
.Height = objOrigShape.Height
.Left = objOrigShape.Left
.LockAnchor = objOrigShape.LockAnchor
.LockAspectRatio = objOrigShape.LockAspectRatio
' .PictureFormat = objOrigShape.PictureFormat
.RelativeHorizontalPosition =
objOrigShape.RelativeHorizontalPosition
.RelativeVerticalPosition =
objOrigShape.RelativeVerticalPosition
' .TextEffect = objOrigShape.TextEffect
' .TextFrame = objOrigShape.TextFrame
' .ThreeD = objOrigShape.ThreeD
.Top = objOrigShape.Top
'ro .Type = objOrigShape.Type
.Width = objOrigShape.Width
.WrapFormat.Type = objOrigShape.WrapFormat.Type 'This
does NOT make it 'behind text', ZOrder does
.ZOrder msoSendBehindText
'ro .ZOrderPosition = objOrigShape.ZOrderPosition
' .Anchor = objOrigShape.Anchor
End With
objNewShape.Visible = msoTrue
'now delete the old signature, or at least make it invisible
objOrigShape.Delete
Else 'don't add sig
'show the orig sig
objOrigShape.Visible = blnShowSignature
End If 'adding sig or not
End If 'found signature
Next 'i shape
End Sub