A Better Way??

[Greg Maxey]

Working with shapes is not one of my favorite pastimes. Regardless, I was
recently asked to work out a method of duplicating floating shapes at
several different locations in a document. The first section of the
document serves as a data sheet and uses formfields to collect common data
(e.g., borrower name, borrower address, lender name, property address, etc)
that is used throughout the remainer of the document. I used REF fields
where appropriate to insert the common data. The form owner wanted to
insert images (jpg format graphic files) of the signature of the key parties
in the document (e.g., borrower, co-borrower, trustee, etc.) into the data
sheet and then have these signature images replicated at various points
throughout the document. Using images inserted as InLineShapes was simple
enough. It was just a matter of bookmarking the image and using REF. For
reasons still not understood, the form owner insisted on floating images
inserted behind text.

I could not find a way (if it exists) to bookmark and reference a floating
image. The solution I came up with is described below.

1. In the data sheet I inserted a two column mulit-row table. The first
column contains macrobutton fields that calls a procedure that allows the
user to browse for and insert the floating image in the second column.
E.g.,

{ Macrobutton GetSigBPic "Borrower Signature" } which displays as "Borrower
Signature." Each of these macrobuttons runs a short procedure with calls to
other procedures as shown in the example below:

SelectedFile = ImagePath
If SelectedFile <> "" Then InsertSIG SelectedFile, 1, "SigB"
End Sub

2. The form owner wanted the signature size to be limited to 1 inch high
by 3 inches wide. I set the row height of the table to exactly 1" and set
the column autofit to "fixed column width.

3. I added bookmarks throughout the document where the various signature
images collected in the data sheet needed to be duplicated. I used
sequentially numbered bookmarks for each party signature. E.g.,
SigBCopy1, SigBCopy2, SigBCopy3 etc. where SigB represents the borrower
signature.

4. The form is protected so I used and AutoOpen macro to set the
ButtonFieldClick option to 1. This allows the macrobuttons to function in
the form.

5. The main procedure first evaluates the document and deletes any previous
signtature image in the data sheet placeholder and any copies at the various
bookmark anchors. Next it inserts, sized and formats the image into the
data sheet placeholder then copies and pastes the image at the bookmark
anchors.

6. The complete code is shown below.

This process is working, but I feel like Rube Goldberg had a hand in it. I
was wondering if anyone else has put together something simplier to do the
same job.

Thanks.

Option Explicit
Dim SelectedFile As String

Sub AutoOpen()
Options.ButtonFieldClicks = 1
End Sub

Sub GetSIGBPic()
SelectedFile = ImagePath
If SelectedFile <> "" Then InsertSIG SelectedFile, 1, "SigB"
End Sub

Sub GetSIGCPic()
SelectedFile = ImagePath
If SelectedFile <> "" Then InsertSIG SelectedFile, 2, "SigC"
End Sub

Sub GetSIGTPic()
SelectedFile = ImagePath
If SelectedFile <> "" Then InsertSIG SelectedFile, 3, "SigT"
End Sub

Function ImagePath() As String
With Application.FileDialog(msoFileDialogFilePicker)
If .Show Then
ImagePath = .SelectedItems(1)
Else
ImagePath = ""
End If
End With
If ImagePath = "" Then MsgBox "You did not select a file"
End Function

Sub InsertSIG(ByRef pName As String, i As Long, pStr As String)
Dim bProtected As Boolean
Dim oShape As shape
Dim oRng As Word.Range
Dim j As Long
Dim oBM As Bookmark
bProtected = False
'Delete previous signature image master and and copies
Set oRng = ActiveDocument.Tables(1).Cell(i, 2).Range
If ActiveDocument.ProtectionType <> wdNoProtection Then
bProtected = True
ActiveDocument.Unprotect
End If
Application.ScreenUpdating = False
For Each oShape In oRng.ShapeRange
oShape.Delete
Next
For j = ActiveDocument.Shapes.Count To 1 Step -1
Set oShape = ActiveDocument.Shapes(j)
If InStr(oShape.Name, pStr) Then
oShape.Delete
End If
Next
'Insert, size and copy master signature image
Set oShape = ActiveDocument.Shapes.AddPicture(FileName:=pName,
LinkToFile:=False, SaveWithDocument:=True, Anchor:=oRng)
With oShape
If .Height > InchesToPoints(1) Then .Height = InchesToPoints(1)
If .Width > InchesToPoints(3) Then .Width = InchesToPoints(3)
If .Type = msoPicture Then oShape.WrapFormat.Type = wdWrapNone
.ZOrder msoSendBehindText
.Name = pStr
.Select
End With
Selection.Copy
'Create duplicates anchored at each designated BM
For Each oBM In ActiveDocument.Bookmarks
If InStr(oBM.Name, pStr & "Copy") Then
Set oRng = oBM.Range
oRng.Paste
Set oShape = oRng.ShapeRange(1)
With oShape
.Name = "Copy" & pStr
.RelativeHorizontalPosition = wdRelativeHorizontalPositionCharacter
.Top = InchesToPoints(0)
.Left = InchesToPoints(0)
End With
End If
Next oBM
Set oShape = Nothing
Application.ScreenUpdating = True
If bProtected Then
ActiveDocument.Protect wdAllowOnlyFormFields, True
End If
End Sub
Sub Document_Close()
'Clear clipboard to avoid on exit message of clipboard contents
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText ""
MyData.PutInClipboard
End Sub

 

[Jean-Guy Marcil]

Greg Maxey was telling us:
Greg Maxey nous racontait que :

Working with shapes is not one of my favorite pastimes. Regardless,
I was recently asked to work out a method of duplicating floating
shapes at several different locations in a document. The first
section of the document serves as a data sheet and uses formfields to
collect common data (e.g., borrower name, borrower address, lender
name, property address, etc) that is used throughout the remainer of
the document. I used REF fields where appropriate to insert the
common data. The form owner wanted to insert images (jpg format
graphic files) of the signature of the key parties in the document
(e.g., borrower, co-borrower, trustee, etc.) into the data sheet and
then have these signature images replicated at various points
throughout the document. Using images inserted as InLineShapes was
simple enough. It was just a matter of bookmarking the image and
using REF. For reasons still not understood, the form owner insisted
on floating images inserted behind text.
I could not find a way (if it exists) to bookmark and reference a
floating image. The solution I came up with is described below.

1. In the data sheet I inserted a two column mulit-row table. The
first column contains macrobutton fields that calls a procedure that
allows the user to browse for and insert the floating image in the
second column. E.g.,

{ Macrobutton GetSigBPic "Borrower Signature" } which displays as
"Borrower Signature." Each of these macrobuttons runs a short
procedure with calls to other procedures as shown in the example
below:
SelectedFile = ImagePath
If SelectedFile <> "" Then InsertSIG SelectedFile, 1, "SigB"
End Sub

2. The form owner wanted the signature size to be limited to 1 inch
high by 3 inches wide. I set the row height of the table to exactly
1" and set the column autofit to "fixed column width.

3. I added bookmarks throughout the document where the various
signature images collected in the data sheet needed to be duplicated.
I used sequentially numbered bookmarks for each party signature. E.g.,
SigBCopy1, SigBCopy2, SigBCopy3 etc. where SigB represents the
borrower signature.

4. The form is protected so I used and AutoOpen macro to set the
ButtonFieldClick option to 1. This allows the macrobuttons to
function in the form.

5. The main procedure first evaluates the document and deletes any
previous signtature image in the data sheet placeholder and any
copies at the various bookmark anchors. Next it inserts, sized and
formats the image into the data sheet placeholder then copies and
pastes the image at the bookmark anchors.

6. The complete code is shown below.

This process is working, but I feel like Rube Goldberg had a hand in
it. I was wondering if anyone else has put together something
simplier to do the same job.

I do not now about "simpler", but I did notice that you were using the
clipboard, which is something I like to avoid, you never now what the user
has in he clipboard that you could be wiping out.

So, instead, I would use something like this to copy the picture, assuming
each original is anchored to a lone paragraph mark which is bookmarked with
an appropriate name:

Dim rgePasteInto As Range

With ActiveDocument.Range
Set rgePasteInto = .Paragraphs(.Paragraphs.Count - 1).Range
With rgePasteInto
.Collapse wdCollapseStart
.FormattedText = ActiveDocument.Range.Bookmarks("Test") _
.Range.FormattedText
End With
End With

 

[Greg Maxey]

JGM,

Thanks for sharing and I like the concept. My original images are anchored
to the cells in the right hand column of the data sheet table. It took a
bit of doing to figure out how to avoid including the end of cell mark in
the rgePasteInto range. Code now looks like this:

Sub InsertSIG(ByRef pName As String, i As Long, pStr As String)
Dim bProtected As Boolean
Dim oShape As shape
Dim oRng As Word.Range
Dim j As Long
Dim oBM As Bookmark
Dim oRngCopy As Range
bProtected = False
'Unprotect document
If ActiveDocument.ProtectionType <> wdNoProtection Then
bProtected = True
ActiveDocument.Unprotect
End If
Application.ScreenUpdating = False
'Delete previous signature image master and copies
Set oRng = ActiveDocument.Tables(1).Cell(i, 2).Range 'Defines range
placeholder for master image
For Each oShape In oRng.ShapeRange
oShape.Delete
Next
'Copies are named when created. Looks for like named shapes and deletes
For j = ActiveDocument.Shapes.Count To 1 Step -1
Set oShape = ActiveDocument.Shapes(j)
If InStr(oShape.Name, pStr) Then
oShape.Delete
End If
Next
'Insert, size and copy master signature image
oRng.Collapse wdCollapseStart 'Prepares shape anchor
Set oShape = ActiveDocument.Shapes.AddPicture(FileName:=pName, _
LinkToFile:=False, SaveWithDocument:=True, Anchor:=oRng)
With oShape
'Evaluate and resize oversized images
If .Height > 68 Or .Width > 216 Then
AdjustOversizedObjects oShape
End If
If .Type = msoPicture Then oShape.WrapFormat.Type = wdWrapNone
.ZOrder msoSendBehindText
.Name = pStr
End With
'Manipulate range to include image anchor and exclude end of cell
Set oRng = ActiveDocument.Tables(1).Cell(i, 2).Range
oRng.End = oRng.End - 1
'Create duplicates anchored at each designated BM
For Each oBM In ActiveDocument.Bookmarks
If InStr(oBM.Name, pStr & "Copy") Then
Set oRngCopy = oBM.Range
oRngCopy.FormattedText = oRng.FormattedText
Set oShape = oRngCopy.ShapeRange(1)
'Name and position copied shapes
With oShape
.Name = "Copy" & pStr
.RelativeHorizontalPosition = wdRelativeHorizontalPositionCharacter
.Top = InchesToPoints(0)
.Left = InchesToPoints(0)
End With
End If
Next oBM
Set oShape = Nothing
Application.ScreenUpdating = True
If bProtected Then
ActiveDocument.Protect wdAllowOnlyFormFields, True
End If
End Sub