Macro functions in dot template not getting copied to new document

[Neha Gupta]

hi,

We have created a macro function to add a row in the existing table
dynamically on the click of a button named 'Add Row'. This function works
when I open the dot template and click on 'Add Row' button. Strangly, when I
create a new document based on this dot template, this macro didn't get
copied into the target new document and works only for the first time. The
custom function will I have created is as shown below:

***************************************************
Private Sub AddRepeating_Click()
ActiveDocument.Unprotect Password:=""
Dim oWord As Word.Application
Dim oRange As Range
Selection.GoTo What:=wdGoToBookmark, Name:="\endofdoc"
ActiveDocument.Tables(3).Rows.Add
tcount = ActiveDocument.Tables(3).Rows.Count

Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(1).Range
Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(1).Range
oRange.Select
Selection.Style = ActiveDocument.Styles("Links")
Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(2).Range
oRange.Select
ProcName = "CmdDeleteLink" & tcount
i = ProcedureExists(ProcName & "_Click", "ThisDocument")
If i = True Then
Do Until i = False
tcount = tcount + 1
ProcName = "CmdDeleteLink" & tcount
i = ProcedureExists(ProcName & "_Click", "ThisDocument")
Loop
End If
Dim shp As Word.InlineShape
Set doc = ThisDocument
Set shp =
doc.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

Dim sCode As String
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"
ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True

ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
End Sub
Private Sub DeleteCode(ProcedureName)
Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim HowManyLines As Long
Set VBCodeMod =
ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule
With VBCodeMod
StartLine = .ProcStartLine(ProcedureName, vbext_pk_Proc)
HowManyLines = .ProcCountLines(ProcedureName, vbext_pk_Proc)
..DeleteLines StartLine, HowManyLines
End With
ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True
End Sub

*****************************************************

Please suggest me how to resolve this issue. Thanks in Advance for your help.

Thanks,Neha

 

[Perry]

Except for a couple of adjustments (I will include later) the code runs
beautifully,
although I can't seem to find a purpose for this besides practice ...?
)

In yr code, the function ProcedureExists() wasn't included, so I recreated
the
function to read like listed below.

Furthermore, I left out all document protect/reprotect statements
(hazzle...)
and changed the private scope from procedure AddRepeating_Click() to read:
Sub AddRepeating_Click()

In same procedure, I changed the targetdocument assignment from ThisDocument
to read ActiveDocument, as in:

Dim shp As Word.InlineShape
Set doc = ThisDocument

to read
Dim shp As Word.InlineShape
Set doc = ActiveDocument

The function I recreated:

Function ProcedureExists(ByVal ProcName As String, _
ByVal sCodeMod As String) As Integer

Dim vbc As VBComponent
Dim iTmp As Integer

On Error GoTo ErrHandler
Set vbc = VBE.ActiveVBProject. _
VBComponents(sCodeMod)

On Error GoTo ErrHandler
iTmp = vbc.CodeModule.ProcStartLine _
(ProcName, vbext_pk_Proc)

ExitHere:
ProcedureExists = iTmp
Exit Function
ErrHandler:
Resume ExitHere
End Function

--
Krgrds,
Perry

System:
Vista/Office Ultimate
VS2005/VSTO2005 SE

 

[Neha Gupta]

Hi Perry,
I did try the Solution given by you but the problem yet remains the same

The functionality of ProcedureExists() module is as given below

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


Function ModuleExists(ModuleName As String) As Boolean
On Error Resume Next
ModuleExists = Len(
ActiveDocument.VBProject.VBComponents(ModuleName).Name) <> 0
End Function

I also changed the addRepeating_Click module as per the instructions given
and it looked as given below

Sub AddRepeating_Click()

Dim oWord As Word.Application
Dim oRange As Range
Selection.GoTo What:=wdGoToBookmark, Name:="\endofdoc"
ActiveDocument.Tables(3).Rows.Add
tcount = ActiveDocument.Tables(3).Rows.Count

Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(1).Range
Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(1).Range
oRange.Select
Selection.Style = ActiveDocument.Styles("Links")
Set oRange = ActiveDocument.Tables(3).Rows(tcount).Cells(2).Range
oRange.Select
ProcName = "CmdDeleteLink" & tcount
i = ProcedureExists(ProcName & "_Click", "ThisDocument")
If i = True Then
Do Until i = False
tcount = tcount + 1
ProcName = "CmdDeleteLink" & tcount
i = ProcedureExists(ProcName & "_Click", "ThisDocument")
Loop
End If
Dim shp As Word.InlineShape
Set doc = ActiveDocument
Set shp =
doc.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

Dim sCode As String
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"


ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
End Sub

Not sure if I am missing some thing very obvious. Please help me to solve
this issue.
Thanks in advance
Neha