Word references are getting lost after I executing 'AddOLEControl'

[Neha Gupta]

Hi all,

I am executing the custom function 'AddRepeating' at a click of a button
which is inturn creating a button which some code. The funtion is working
fine but as soon as the 'AddOLEControl' function (inside AddRepeating), the
references to the existing dot templates is lost. As a result, the custom
function defined in the referneced dot template is called only once.

Please let me know if you know how is problem can be solved? The custom
function which I am using is:

Public Sub AddRepeating_Click()
MsgBox ("dot template mein hoon")

'Dim oWord As Word.Application
Dim oRange As Range
Dim oRange1 As Range
Dim shp As Word.InlineShape
Dim sCode As String
ActiveDocument.Unprotect Password:=""
Selection.GoTo What:=wdGoToBookmark, Name:="\endofdoc"
ActiveDocument.Tables(3).Rows.Add
tcount = ActiveDocument.Tables(3).Rows.Count
MsgBox (tcount)
Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(1).Range
Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(1).Range
oRange.Select
MsgBox ("hello")
Selection.Style = ActiveDocument.Styles("Links")
Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(2).Range
oRange.Select
ProcName = "CmdDeleteLink" & tcount
MsgBox (ProcName)
i = ProcedureExists(ProcName & "_Click", "ActiveDocument")
If i = True Then
Do Until i = False
tcount = tcount + 1
ProcName = "CmdDeleteLink" & tcount
i = ProcedureExists(ProcName & "_Click", "ActiveDocument")
Loop
MsgBox ("Final name" + ProcName)
End If
MsgBox ("phase 1 complete")

Set shp =
ThisDocument.Content.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1", Range:=oRange)
shp.OLEFormat.Object.Caption = "Delete"
shp.OLEFormat.Object.Name = ProcName
shp.OLEFormat.Object.BackColor = &HC0C0C0
shp.Height = 20
shp.Width = 44.8
MsgBox ("creating private function")

MsgBox (sCode)
MsgBox (ThisDocument)
MsgBox (ActiveDocument)
sCode = "Private Sub " & shp.OLEFormat.Object.Name & "_Click()" &
vbCrLf & _
"ActiveDocument.Unprotect Password:=""""" & vbCrLf & _
"ProcedureName =""" & shp.OLEFormat.Object.Name & "_Click""" & vbCrLf & _
"Dim oRange As Range" & vbCrLf & _
"Me." & shp.OLEFormat.Object.Name & ".Select" & vbCrLf & _
"Selection.Range.Rows.Delete" & vbCrLf & _
"DeleteCode ProcedureName" & vbCrLf & _
"End Sub"
MsgBox (sCode)
MsgBox (ThisDocument)
MsgBox (ActiveDocument)


ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True
End Sub

Function ProcedureExists(ProcedureName As String, _
ModuleName As String) As Boolean
On Error Resume Next
If ModuleExists(ModuleName) = True Then
ProcedureExists = ActiveDocument.VBProject.VBComponents(ModuleName) _
.CodeModule.ProcStartLine(ProcedureName, vbext_pk_Proc) <> 0
End If
End Function