Protected Form with Table Row Add capability

[stevewy]

I work in a centralized word processing department for a local
authority. I have a customer who wants to set up a series of tables
as a Word protected form, so that the people filling it in cannot
change it. So far so good, but he also wants them to be able to
insert extra rows in the table where required (with form fields in
them so they can input further information into them). None of the
form fields in the document have specific names, so he isn't planning
on extracting them to a database once the document is complete or
anything. He just wants to stop people from changing the document in
ways he doesn't want them to, but he does want them to be able to
insert extra table rows. I would imagine an ability to insert a table
row immediately beneath the current cursor position is what he has in
mind - in other words in a new row after the current row.

I did tell him that he is rather wanting to have his cake and eat it,
because the idea of Word Forms is that the user cannot change any
aspect of the protected form, just input information. However, can
anyone think of a way (perhaps using VBA?) of having a protected form
but still being able to insert extra rows in a table (complete with
blank form fields)? I did try doing a version of this, using a macro,
but Word gave me an error when I tried to play the macro, saying
macros cannot be played in protected areas of a document.

Is there a way in VBA I can slightly change what is allowed in a
protected form, and what isn't?

Any help on this would be appreciated.

Steve Wylie
Kent
UK

 

[Graham Mayor]

I agree with your sentiment to the customer, however it can be done if you
run the following macro from the last form field in each row that may
require a further row. Anything other than the default 'No' in response to
the prompt will insert a new row of blank form fields to match the row that
called it. This does however rely on the user allowing the macro to run, and
any form protection is easily circumvented. If the form is password
protected you'll have to insert the password in the code at the two places
indicated by Password:=""

Sub AddARow()
Dim i As Integer
Dim bProtected As Boolean
Dim sNewRow As String
Dim oFld As FormFields

sNewRow = InputBox("Insert New Row", "New Row", "No")
If Left(UCase(sNewRow), 1) <> "N" Then
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
bProtected = True
ActiveDocument.Unprotect Password:=""
End If

With Selection
.SelectRow
.Copy
.Paste
.SelectRow
Set oFld = Selection.Range.FormFields
For i = 1 To oFld.Count
oFld(i).Result = ""
Next
End With

If bProtected = True Then
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End If
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Greg Maxey]

This one is a little longer than Graham's put it does account for the
possibility of calculation fields and removes the onexit macro from the
previous last row.

Sub AddRow()
Dim pTable As Word.Table
Dim curCursor As Long
Dim bCalcField As Boolean
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim rowsToAdd As Long
Dim rowAdd As Long
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

Set pTable = Selection.Tables(1)
If MsgBox("Do you want to add a row?", vbQuestion + vbYesNo, "Add Rows") =
vbYes Then
rowsToAdd = 1
Else
Exit Sub
End If
'Minimize screen flicker
curCursor = System.Cursor
System.Cursor = wdCursorWait
Application.ScreenUpdating = False
'Determine if calculation fields are present and set a flag
On Error GoTo Err_Handler
Set oRng1 = pTable.Rows(pTable.Rows.Count).Range
bCalcField = False
For i = 1 To oRng1.FormFields.Count
If oRng1.FormFields(i).TextInput.Type = wdCalculationText Then
bCalcField = True
Exit For
End If
Next i
'Unprotect document.
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
Set oRng1 = pTable.Rows(pTable.Rows.Count).Range
Set oRng2 = oRng1.Duplicate
With oRng1
.Copy
.Collapse Direction:=wdCollapseEnd
.Paste
End With
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
Next
'Call subroutine to build new calculation field
If bCalcField Then
BuildNewCalcFieldExpressions oRng1, oRng2
End If
pRowIndex = pTable.Rows.Count - rowsToAdd + 1
oBmName = pTable.Rows(pRowIndex).Cells(1).Range.Bookmarks(1).Name
ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select
'Clear onExit Macro from previous last row.
Set oRng1 = pTable.Rows(pTable.Rows.Count - 1).Range
oRng1.FormFields(oRng1.FormFields.Count).ExitMacro = ""
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
'Restore visuals
Application.ScreenUpdating = True
System.Cursor = curCursor
Exit Sub
Err_Handler:
If Err.Number = 5991 Then
MsgBox Err.Description
Else
MsgBox "Unknown error."
End If
End Sub
Sub BuildNewCalcFieldExpressions(ByVal oRng1 As Range, oRng2 As Range)
'Construct any new calculation fields. Credit for this section goes to
fellow
'MVP Tony Jollans
Dim oFF As FormField
Dim strOldVar As String
Dim strNewVar As String
Dim strNewCalc As String
Dim ndx As Long
Dim ndx2 As Long
Dim lngVarPosit As Long
Dim lngVarNextPosit As Long
Dim bVariableFound As Boolean
Dim bVariableReplace As Boolean
For ndx = 1 To oRng1.FormFields.Count
Set oFF = oRng1.FormFields(ndx)
If oFF.Type = wdFieldFormTextInput Then
If oFF.TextInput.Type = wdCalculationText Then
strNewCalc = oFF.TextInput.Default
For ndx2 = 1 To oRng2.FormFields.Count
strOldVar = oRng2.FormFields(ndx2).Name
lngVarPosit = 1
Do While lngVarPosit > 0
lngVarPosit = InStr(lngVarPosit, strNewCalc, strOldVar)
bVariableFound = lngVarPosit > 0
bVariableReplace = bVariableFound
If bVariableReplace Then
If lngVarPosit > 1 Then
If Mid$(strNewCalc, lngVarPosit - 1) Like "[0-9A-Z_a-z]" Then
bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
lngVarNextPosit = lngVarPosit + Len(strOldVar)
If lngVarNextPosit <= Len(strNewCalc) Then
If Mid$(strNewCalc, lngVarNextPosit) Like "[0-9A-Z_a-z]" Then
bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
strNewVar = oRng1.FormFields(ndx2).Name
strNewCalc = Left$(strNewCalc, lngVarPosit - 1) & strNewVar &
Mid$(strNewCalc, lngVarNextPosit)
lngVarPosit = lngVarPosit + Len(strNewVar)
Else
If bVariableFound Then
lngVarPosit = lngVarPosit + Len(strOldVar)
End If
End If
Loop
Next ndx2
oFF.Select
With Dialogs(wdDialogFormFieldOptions)
.TextDefault = strNewCalc
.Execute
End With
End If
End If
Next ndx
End Sub

 

[Graham Mayor]

A 'little' longer?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

This one is a little longer than Graham's put it does account for the
possibility of calculation fields and removes the onexit macro from
the previous last row.

Sub AddRow()
Dim pTable As Word.Table
Dim curCursor As Long
Dim bCalcField As Boolean
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim rowsToAdd As Long
Dim rowAdd As Long
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

Set pTable = Selection.Tables(1)
If MsgBox("Do you want to add a row?", vbQuestion + vbYesNo, "Add
Rows") = vbYes Then
rowsToAdd = 1
Else
Exit Sub
End If
'Minimize screen flicker
curCursor = System.Cursor
System.Cursor = wdCursorWait
Application.ScreenUpdating = False
'Determine if calculation fields are present and set a flag
On Error GoTo Err_Handler
Set oRng1 = pTable.Rows(pTable.Rows.Count).Range
bCalcField = False
For i = 1 To oRng1.FormFields.Count
If oRng1.FormFields(i).TextInput.Type = wdCalculationText Then
bCalcField = True
Exit For
End If
Next i
'Unprotect document.
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
Set oRng1 = pTable.Rows(pTable.Rows.Count).Range
Set oRng2 = oRng1.Duplicate
With oRng1
.Copy
.Collapse Direction:=wdCollapseEnd
.Paste
End With
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
Next
'Call subroutine to build new calculation field
If bCalcField Then
BuildNewCalcFieldExpressions oRng1, oRng2
End If
pRowIndex = pTable.Rows.Count - rowsToAdd + 1
oBmName = pTable.Rows(pRowIndex).Cells(1).Range.Bookmarks(1).Name
ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select
'Clear onExit Macro from previous last row.
Set oRng1 = pTable.Rows(pTable.Rows.Count - 1).Range
oRng1.FormFields(oRng1.FormFields.Count).ExitMacro = ""
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
'Restore visuals
Application.ScreenUpdating = True
System.Cursor = curCursor
Exit Sub
Err_Handler:
If Err.Number = 5991 Then
MsgBox Err.Description
Else
MsgBox "Unknown error."
End If
End Sub
Sub BuildNewCalcFieldExpressions(ByVal oRng1 As Range, oRng2 As Range)
'Construct any new calculation fields. Credit for this section goes
to fellow
'MVP Tony Jollans
Dim oFF As FormField
Dim strOldVar As String
Dim strNewVar As String
Dim strNewCalc As String
Dim ndx As Long
Dim ndx2 As Long
Dim lngVarPosit As Long
Dim lngVarNextPosit As Long
Dim bVariableFound As Boolean
Dim bVariableReplace As Boolean
For ndx = 1 To oRng1.FormFields.Count
Set oFF = oRng1.FormFields(ndx)
If oFF.Type = wdFieldFormTextInput Then
If oFF.TextInput.Type = wdCalculationText Then
strNewCalc = oFF.TextInput.Default
For ndx2 = 1 To oRng2.FormFields.Count
strOldVar = oRng2.FormFields(ndx2).Name
lngVarPosit = 1
Do While lngVarPosit > 0
lngVarPosit = InStr(lngVarPosit, strNewCalc, strOldVar)
bVariableFound = lngVarPosit > 0
bVariableReplace = bVariableFound
If bVariableReplace Then
If lngVarPosit > 1 Then
If Mid$(strNewCalc, lngVarPosit - 1) Like "[0-9A-Z_a-z]"
Then bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
lngVarNextPosit = lngVarPosit + Len(strOldVar)
If lngVarNextPosit <= Len(strNewCalc) Then
If Mid$(strNewCalc, lngVarNextPosit) Like "[0-9A-Z_a-z]"
Then bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
strNewVar = oRng1.FormFields(ndx2).Name
strNewCalc = Left$(strNewCalc, lngVarPosit - 1) &
strNewVar & Mid$(strNewCalc, lngVarNextPosit)
lngVarPosit = lngVarPosit + Len(strNewVar)
Else
If bVariableFound Then
lngVarPosit = lngVarPosit + Len(strOldVar)
End If
End If
Loop
Next ndx2
oFF.Select
With Dialogs(wdDialogFormFieldOptions)
.TextDefault = strNewCalc
.Execute
End With
End If
End If
Next ndx
End Sub

I work in a centralized word processing department for a local
authority. I have a customer who wants to set up a series of tables
as a Word protected form, so that the people filling it in cannot
change it. So far so good, but he also wants them to be able to
insert extra rows in the table where required (with form fields in
them so they can input further information into them). None of the
form fields in the document have specific names, so he isn't planning
on extracting them to a database once the document is complete or
anything. He just wants to stop people from changing the document in
ways he doesn't want them to, but he does want them to be able to
insert extra table rows. I would imagine an ability to insert a
table row immediately beneath the current cursor position is what he
has in mind - in other words in a new row after the current row.

I did tell him that he is rather wanting to have his cake and eat it,
because the idea of Word Forms is that the user cannot change any
aspect of the protected form, just input information. However, can
anyone think of a way (perhaps using VBA?) of having a protected form
but still being able to insert extra rows in a table (complete with
blank form fields)? I did try doing a version of this, using a
macro, but Word gave me an error when I tried to play the macro,
saying macros cannot be played in protected areas of a document.

Is there a way in VBA I can slightly change what is allowed in a
protected form, and what isn't?

Any help on this would be appreciated.

Steve Wylie
Kent
UK

 

[stevewy]

Thanks for that response, Greg, but I cannot see any original reply
from Graham. I am looking at this from Google Groups, and there is
only the long reply from Greg... Can you repeat what you said in your
first response, Graham?

Steve

 

[Graham Mayor]

The reply was as follows:

I agree with your sentiment to the customer, however it can be done if you
run the following macro from the last form field in each row that may
require a further row. Anything other than the default 'No' in response to
the prompt will insert a new row of blank form fields to match the row that
called it. This does however rely on the user allowing the macro to run, and
any form protection is easily circumvented. If the form is password
protected you'll have to insert the password in the code at the two places
indicated by Password:=""

Sub AddARow()
Dim i As Integer
Dim bProtected As Boolean
Dim sNewRow As String
Dim oFld As FormFields

sNewRow = InputBox("Insert New Row", "New Row", "No")
If Left(UCase(sNewRow), 1) <> "N" Then
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
bProtected = True
ActiveDocument.Unprotect Password:=""
End If

With Selection
.SelectRow
.Copy
.Paste
.SelectRow
Set oFld = Selection.Range.FormFields
For i = 1 To oFld.Count
oFld(i).Result = ""
Next
End With

If bProtected = True Then
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End If
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[stevewy]

I'm getting an error on oFld(i).Result = "" saying Bad parameter.

 

[Graham Mayor]

It works in Word 2003 and 2007. I will send a copy of the sample document
and macro to your hotmail address.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[stevewy]

Ah! On further inspection, I think the error is being caused by how
this customer has his table set out (badly!) I shall tidy up the
table properly, and the macro will then work.

Thank you for your assistance on this, Graham & Greg.

Steve

 

[stevewy]

Sorry, Graham - I still cannot get this macro to work properly on my
document, and I don't know why. Is there any chance I could e-mail
you the document (only two pages, 67Kb), with the macro in it, and you
could see why? The macro is inserting the new row at the foot of the
table - not after the current row as it should - and splitting the
table just above the original row...

Steve

 

[Graham Mayor]

Send it to the link on my web site home page.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>