I have multiple buttons in my word document and I’d like to programmatically add event handlers to them.
After searching this site I managed to implement this code:
Sub AddEH()
Set shp = GetObjectByName("reset_1")
Dim sCode As String
sCode = "Private Sub " & "reset_1" & "_Click()" & vbCrLf & _
" MsgBox ""You Clicked the CommandButton""" & vbCrLf & _
"End Sub"
Me.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
End Sub
GetObjectByName is my own function to get an object by name (if this can be simplified please suggest how)
Function GetObjectByName(ByVal name As String)
For Each obj In Me.InlineShapes
thisName = obj.OLEFormat.Object.name
If thisName = name Then
Set tb = obj.OLEFormat.Object 'must use in order to refer to an object
Exit For
End If
Next obj
Set GetObjectByName = tb
End Function
I “Call AddEH” at the end of “Document_Open()”.
The new event handler is added and works as expected. The problem is that when the the user saved the doc and reopens it, the code tried to add the same event handler again and an error message appears.
How can I prevent this? I want to programmatically added ode to be entered only once.
I am not sure if your attempt to inject code into a document is the best attempt, but let’s for the moment forget about that.
As far as I understand, you execute the routine that writes the code whenever the document is opened. As a consequence, that routine should check if the code is already present. You can access the code of a module using the lines-property of the CodeModule
of a project. I created a simple function that searches for a string at the beginning of every line of code. The reason to look at the beginning is that the search needs to ensure that it doesn’t find the code that creates the sub.
The code currently loops over all modules of a project of a document.
Function FindRoutine(doc As Document, searchString As String) As Boolean
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = doc.VBProject
If VBProj Is Nothing Then
MsgBox "No code module found."
Exit Function
End If
Set VBComp = VBProj.VBComponents("ThisDocument")
For Each VBComp In VBProj.VBComponents
Dim CodeMod As VBIDE.CodeModule
Set CodeMod = VBComp.CodeModule
Dim i As Long, line As String
For i = 1 To CodeMod.CountOfLines
line = Trim(CodeMod.Lines(i, 1))
If Left(line, Len(searchString)) = searchString Then
FindRoutine = True
Exit Function
End If
Next
Next
End Function
And your code that generates the routine could look like
Sub AddEH()
Set shp = GetObjectByName("reset_1")
Dim subDefinition As String
subDefinition = "Private Sub " & "reset_1" & "_Click()"
If Not (FindRoutine(ThisDocument, subDefinition)) Then
Dim sCode As String
sCode = subDefinition & vbCrLf & _
" MsgBox ""You Clicked the CommandButton""" & vbCrLf & _
"End Sub"
ThisWorkbook.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
End If
End Sub