PDA

View Full Version : Macro that Inserts a Field with an On Exit action attached



Avelie47
12-09-2011, 07:24 AM
Hi All!

I am working on some code that is connected to a Word form. The form is protected for "Forms", so the users can only input information into the available form fields. However, there are some tables in the form that may require additional rows at the user's discretion, so I have created a macro that fires on exit of the last field in the row. A msgbox then pops up and reads: "Do you wish to add an extra row?" vbYesNo. If Yes, then my code unprotects the form, adds the additional row and fields, re-protects the form and takes them to the first field in the new row.

However, in the last field of the new row, I need to have the same property for the macro that will fire on exit again and I'm not sure how to code it. I have tried just copying the field, but obviously if the user has input something into that field, it will automatically show up in the new row. Besides, I'd rather hard code it so that I'm not dealing with copy and pastes...

If anyone knows how to update the code with the On Exit macro attached, I'd really appreciate it! I can provide more of my code if necessary.



Selection.FormFields.Add _
Range:=Selection.Range, Type:=wdFieldFormTextInput


Thanks!

gmaxey
12-09-2011, 01:53 PM
Sub ScratchMacro()
'A quick macro scratch pad created by Greg Maxey
Dim oFF As FormField
Set oFF = Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput)
oFF.ExitMacro = "OnExitMacro"
End Sub
Sub OnExitMacro()
MsgBox "Test"
End Sub

Avelie47
12-12-2011, 11:35 AM
Thanks so much for your suggestion Greg!

Unfortunately, when I add that code in, I get a compile error: "Invalid use of property."

Could this be because I am referencing the same macro that the code is in?

In case it could be helpful, I've attached my code:

Public Sub Section3()

On Error GoTo NA
Dim MoreRows As String
Dim Sec3Field As FormField

MoreRows = MsgBox("Do you require space for additional names?", vbYesNo, "Add Rows")

If MoreRows = vbYes Then
GoTo Proceed
ElseIf MoreRows = vbNo Then
GoTo NotRequired
End If

Proceed:
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect ("fakepassword")
Else
GoTo NA
End If

Set Sec3Field = Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput)

ActiveDocument.Bookmarks("EndofSec3").Select
Selection.InsertRowsBelow 1
Selection.HomeKey Unit:=wdLine
Selection.TypeText Text:="Name:"
Selection.MoveRight Unit:=wdCell
ActiveDocument.Bookmarks.Add "Start3"
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Location:"
Selection.MoveRight Unit:=wdCell
Sec3Field.ExitMacro "Section3"
ActiveDocument.Bookmarks.Add "EndofSec3"
ActiveDocument.Protect wdAllowOnlyFormFields, NoReset, "fakepassword"
ActiveDocument.Bookmarks("Start3").Select

Exit Sub

NA:
MsgBox "Row could not be added." & Chr(13) & Chr(13) & "Please notify the administrator.", vbCritical, "Macro Failed"

NotRequired:

End Sub

gmaxey
12-12-2011, 11:46 AM
Could be because your are missing the "=" sign:

Sec3Field.ExitMacro = "Section3"

Avelie47
12-12-2011, 11:54 AM
Oh crap -- sorry about that!

Now I am no longer getting the error message, but it's not actually adding in the new field. It adds a new line, then adds "Name:" in the first cell, moves right to the next cell and adds a plain form field, moves right again and adds "Location:" and then moves right a final time, however the form field with the exit macro isn't added.

Should I be adding the field and then defining it with an exit macro? I thought that by setting the "Sec3Field" variable, it would do that already...

Everything else works fine.

gmaxey
12-12-2011, 12:14 PM
I am not 100% sure exactly what you are trying to do, but if it is just adding a duplicate row and then why don't you copy and paste the last row:

Sub NewRow()
Dim pTable As Word.Table
Dim curCursor As Long
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim oFF As Word.FormField
Dim oRowID As Long
Dim i As Long
Dim pNewName As String
Dim pNameSeparator As Long
Dim pRowIndex
Dim oBmName As String

If MsgBox("Do you require space for additional names?", vbYesNo, "Add Rows") = vbYes Then
Set pTable = Selection.Tables(1)
'Minimize screen flicker
curCursor = System.Cursor
System.Cursor = wdCursorWait
Application.ScreenUpdating = False
On Error GoTo Err_Handler

'Unprotect document.
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
Set oRng1 = pTable.Rows.Last.Range
Set oRng2 = oRng1.Duplicate
'Copy then paste the last row
With oRng1
.Copy
.Collapse Direction:=wdCollapseEnd
.Paste
End With
'Reformat new copied formfields
For i = 1 To oRng1.FormFields.Count
oRowID = pTable.Rows.Count
'Build and assign formfield bookmark names
oRng1.FormFields(i).Select
'Build new name
pNewName = oRng2.FormFields(i).Name
pNameSeparator = InStr(pNewName, "_Row")
If pNameSeparator > 0 Then
pNewName = Left(pNewName, pNameSeparator - 1)
End If
'Prevent assigning an existing bookmark name
If ActiveDocument.Bookmarks.Exists(pNewName & "_Row" & oRowID) Then
MsgBox "Invalid action. A form field with the bookmark name " _
& pNewName & "_" & oRowID _
& " already appears this table. Exiting this procedure."
pTable.Rows(oRowID).Delete
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
Exit Sub
End If
With Dialogs(wdDialogFormFieldOptions)
.Name = pNewName & "_Row" & oRowID
'Assign valid bookmark name to new formfield
.Execute
End With
'Clear previous on exit macros if used.
If oRng2.FormFields(i).ExitMacro = "NewRow" Then
oRng2.FormFields(i).ExitMacro = ""
End If
Next
pRowIndex = pTable.Rows.Count
oBmName = pTable.Rows(pRowIndex).Cells(1).Range.Bookmarks(1).Name
ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
'Restore visuals
Application.ScreenUpdating = True
System.Cursor = curCursor
End If
Exit Sub
Err_Handler:
If Err.Number = 5991 Then
MsgBox Err.Description
Else
MsgBox "Unknown error."
End If
End Sub