Code for insertion point

[KayPat]

Here is my complete code that inserts and removes a watermark and inserts a signature behind text from a drive. My only problem is that i need to be able to insert the signature to where my curser points, can anyone help with this part?


Sub InsertWatermark()
Dim oRg As Range
Dim oTempl As Template, tempTempl As Template
Dim oBBE As BuildingBlock, tempBBE As BuildingBlock
Dim idx As Long
Dim BBEname As String

BBEname = "DRAFT"

Templates.LoadBuildingBlocks

Set oRg = _
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
oRg.Collapse wdCollapseStart

For Each tempTempl In Templates
If InStr(LCase(tempTempl.Name), "building blocks.dotx") Then
Set oTempl = tempTempl
Exit For
End If
Next

If oTempl Is Nothing Then
MsgBox "Building Blocks.dotx not found"
Exit Sub
End If

For idx = 1 To oTempl.BuildingBlockEntries.Count
Set tempBBE = oTempl.BuildingBlockEntries(idx)
If InStr(LCase(tempBBE.Name), LCase(BBEname)) Then
Set oBBE = tempBBE
Exit For
End If
Next

If oBBE Is Nothing Then
MsgBox BBEname & " not found"
Exit Sub
End If

oBBE.Insert Where:=oRg, RichText:=True
End Sub
Sub RemoveWatermark()
Application.ScreenUpdating = False
Dim RngSel As Range, Scn As Section, HdFt As HeaderFooter, iView As Long
With ActiveDocument
Set RngSel = Selection.Range
iView = ActiveWindow.View.Type
For Each Scn In .Sections
For Each HdFt In Scn.Headers
HdFt.Range.Select
WordBasic.RemoveWatermark
Next
For Each HdFt In Scn.Footers
HdFt.Range.Select
WordBasic.RemoveWatermark
Next
Next
End With
RngSel.Select
ActiveWindow.View.Type = iView
Set RngSel = Nothing
Application.ScreenUpdating = True
End Sub
Sub Signature()
Application.ScreenUpdating = False
Dim Rng As Range, Shp As Shape, StrImg As String
StrImg = "C:\Signature.jpeg"
Set Rng = Selection.Range
Rng.Collapse
Set Shp = ActiveDocument.InlineShapes.AddPicture(FileName:=StrImg, _
SaveWithDocument:=True, Range:=Rng).ConvertToShape
With Shp
.LockAspectRatio = True
.Left = CentimetersToPoints(0)
.Top = CentimetersToPoints(20)
.Width = CentimetersToPoints(2.5)
.WrapFormat.Type = wdWrapBehind
End With
Set Rng = Nothing: Set Shp = Nothing
Application.ScreenUpdating = True
End Sub

[gmaxey]

.Top and .Left are what define where the picture ends up relative to the page.

Why don't you create a signature building block and insert it at the selection:

Sub InsertWatermark()
Dim oRng As Range
Dim oTmp As Template
Dim oBB As BuildingBlock
Dim strBBName As String
strBBName = "Draft"
Templates.LoadBuildingBlocks
For Each oTmp In Templates
If LCase(oTmp.Name) = "built-in building blocks.dotx" Then
Exit For
End If
Next oTmp
If oTmp Is Nothing Then
MsgBox "Building Blocks.dotx not found"
Exit Sub
Else
On Error Resume Next
Set oBB = oTmp.BuildingBlockEntries(strBBName)
Select Case Err.Number
Case 0
Set oRng = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
oRng.Collapse wdCollapseStart
oBB.Insert Where:=oRng, RichText:=True
Case 5941
MsgBox strBBName & " not found"
Case Else
MsgBox Err.Number & " " & Err.Description
End Select
End If
End Sub
Sub RemoveWatermark()
Dim oSec As Word.Section
Dim lngIndex As Long
Dim oRng As Word.Range
For Each oSec In ActiveDocument.Sections
For lngIndex = 1 To 3
Set oRng = oSec.Headers(1).Range
WordBasic.RemoveWatermark oRng
Next lngIndex
Next oSec
End Sub
Sub Signature()
Dim oRng As Range
Dim oTmp As Template
Dim oBB As BuildingBlock
Dim strBBName As String
strBBName = "SignatureBB"
Templates.LoadBuildingBlocks
For Each oTmp In Templates
If LCase(oTmp.Name) = "building blocks.dotx" Then
Exit For
End If
Next oTmp
If oTmp Is Nothing Then
MsgBox "Building Blocks.dotx not found"
Exit Sub
Else
On Error Resume Next
Set oBB = oTmp.BuildingBlockEntries(strBBName)
Select Case Err.Number
Case 0
Set oRng = Selection.Range
oRng.Collapse wdCollapseStart
oBB.Insert Where:=oRng, RichText:=True
Case 5941
MsgBox strBBName & " not found"
Case Else
MsgBox Err.Number & " " & Err.Description
End Select
End If
End Sub