Macro to add a text form field in a word document 'on the fly'

If you have any text fields, the document has to be protected for forms. This means that you cannot enter text outside the form text fields, so you would need form fields in the first three columns as well. Does that sound OK?
Show the Forms toolbar to work with a form document, if you need to experiment. You lock the form with the padlock icon to test it in user mode.

Yes, I'm aware the main issue is... 'form protection', and this is why I have doubts that it can be done.
To compound the problem further, I need to be able to expand the rows as required, which form protection doesn't take to kindly.

If you want to prevent the user from modifying text in some places, while allowing it in others, normally FormFields is the way to go.

It is possible,via a toolbar button for instance, to have a VBA macro that would unprotect the document, add another row, inserting the text form fields that would now be required in the first three columns. It would also add the labels (user-unmodifiable data) and the text formfields into the fourth column. It would then re-protect the document.

Yes, this coding is exactly what I'm after, unfortunately a little out of my league.

I've include the table creation in this. You may not need it, but try it on a new document. It will calls the Addrow procedure (the bit that you asked for) once.


Option Explicit

Sub AddTable()
    Dim tbl As Table
    Dim doc As Document
    Set doc = ActiveDocument
    Set tbl = doc.Tables.Add(ActiveDocument.Bookmarks("\EndOfDoc").Range, 1, 4)
    doc.Protect wdAllowOnlyFormFields ' , Password
    AddRow tbl
End Sub

Sub AddRow(tbl As Table)
Dim c As Integer
Dim rw As Row
Dim doc As Document
Dim rng As Range
Set doc = tbl.Range.Document
doc.Unprotect 'Password
Set rw = tbl.Rows.Add
For c = 1 To 3
doc.FormFields.Add rw.Cells(c).Range, wdFieldFormTextInput
Next c

Set rng = rw.Cells(4).Range
rng.Text = "Name: "
rng.Collapse wdCollapseEnd
rng.Move wdCharacter, -1
doc.FormFields.Add rng, wdFieldFormTextInput

Set rng = rw.Cells(4).Range
rng.Collapse wdCollapseEnd
rng.Move wdCharacter, -1
rng.InsertAfter vbCr & "Address: "
rng.Collapse wdCollapseEnd
doc.FormFields.Add rng, wdFieldFormTextInput

Set rng = rw.Cells(4).Range
rng.Collapse wdCollapseEnd
rng.Move wdCharacter, -1
rng.InsertAfter vbCr & "Position: "
rng.Collapse wdCollapseEnd
doc.FormFields.Add rng, wdFieldFormTextInput

doc.Protect wdAllowOnlyFormFields ' , Password
End Sub

Firstly, allow me to apologise for my rudeness in not replying sooner. The unfortunate part of my employment is the need to travel at the most inopportune time. The good news is .... that's the last of my (work) travel until the new year.  

If you are still in a position to help, I would appreciate your assistance.  I used the above macro as you suggested and had reasonable success (I did have to install an 'unprotect' command to allow for the next row to be added to the table).
However, I'm having the following problems;
1. When I add a new row, all of the text is deleted from the rows above.
2. I also need to be able to adjust the width of each cell, as some columns need to be wider than others.

Thanks
WayneS


 

Sorry. I left out the 'No Reset' parameter from the Protect statement in both procedures. It should read.

doc.Protect wdAllowOnlyFormFields, True ' , Password

You can set the width of a whole column:

    tbl.Columns(1).Width = CentimetersToPoints(2)

or of a single cell:
    tbl.Cell(2,2).Width = CentimetersToPoints(1.5)

.....I'm almost there !

When I run the macro it's creating 'two' rows each time, instead of one. I think this is also causing some conflict with the column 'widths', because I continually get an error meassage when I adjust the width.
Message reads: " Cannot access individual columns in this collection because the table has mixed cell widths"
The row with the field text  will adjust okay, but the additional row that's created does not adjust. How can I get rid of this unwanted row ?
Thankyou

You haven't posted your code, so I can't explain why you are getting two rows.

If you don't need to have cells within a column to have different widths, I would set the column widths when the table is created. New rows will automatically copy the widths of the original settings.

Sub AddTable()
    Dim tbl As Table
    Dim doc As Document
    Set doc = ActiveDocument
    Set tbl = doc.Tables.Add(ActiveDocument.Bookmarks("\EndOfDoc").Range, 1, 4)
    tbl.Columns(1).Width = CentimetersToPoints(2)
    doc.Protect wdAllowOnlyFormFields, True ' , Password
    AddRow tbl
End Sub

I thought I was almost there ... maybe not.
What am I doing wrong, no matter what I do I still get two rows each time I run the 'AddTable'. As well as that, adjusting the colum width still results in the "mixed cell width" error. (If it helps, cells within each column will not have different width,  they will be uniform.)
Below is the code I'm using thus far. Could I again ask for your assistance, as I'm running out of hair.

Option Explicit

Sub AddTable()
    Dim tbl As Table
    Dim doc As Document
    Set doc = ActiveDocument
    doc.Unprotect 'Password
    Set tbl = doc.Tables.Add(ActiveDocument.Bookmarks("\EndOfDoc").Range, 1, 4)
    'tbl.Columns(1).Width = CentimetersToPoints(1)
    'tbl.Columns(2).Width = CentimetersToPoints(2)
    'tbl.Columns(3).Width = CentimetersToPoints(4)
    'tbl.Columns(4).Width = CentimetersToPoints(7)
    doc.Protect wdAllowOnlyFormFields, True ' , Password
    AddRow tbl
End Sub


Sub AddRow(tbl As Table)
Dim c As Integer
Dim rw As Row
Dim doc As Document
Dim rng As Range
Set doc = tbl.Range.Document
doc.Unprotect 'Password
Set rw = tbl.Rows.Add
For c = 1 To 3
doc.FormFields.Add rw.Cells(c).Range, wdFieldFormTextInput
Next c

Set rng = rw.Cells(4).Range
 
rng.Text = "Heading: "
rng.Text = "Name: "
rng.Collapse wdCollapseEnd
rng.Move wdCharacter, -1
doc.FormFields.Add rng, wdFieldFormTextInput

Set rng = rw.Cells(4).Range
rng.Collapse wdCollapseEnd
rng.Move wdCharacter, -1
rng.InsertAfter vbCr & "Address: "
rng.Collapse wdCollapseEnd
doc.FormFields.Add rng, wdFieldFormTextInput

Set rng = rw.Cells(4).Range
rng.Collapse wdCollapseEnd
rng.Move wdCharacter, -1
rng.InsertAfter vbCr & "Position: "
rng.Collapse wdCollapseEnd
doc.FormFields.Add rng, wdFieldFormTextInput


doc.Protect wdAllowOnlyFormFields, True ' , Password
End Sub

....many thanks

The AddTable is intended to set up the first (header) row, and then to add one 'body' row by calling the AddRow Sub. To add more rows, run the AddRow each time that you need it. It you run AddTable again it adds another table, but there will be no separating paragraph mark, so the new table will be merged with the preceding table.

Unfortunately I can't seem to find the 'AddRow' macro in the macro list, all that appears is the 'AddTable' macro.
The  'AddTable' macro is therefore the only macro I can actually run,and it seems to me to be the cause of a lot of my probelms.    

As my document template will already have a 'header' table row installed, I really don't need the table creating ability of the AddTable macro, all I need to do is be able to add to the header row.
Thankyou again.

I have lift off ... thanks for hanging in as long as you did.  Your points are well deserved.