Insert a Field and assign to button

S

Sarah_Lecturer

Please help me; I have designed a form which is to be used as a template. I
need the user to be able to insert another field if required so i though I
would create a button with a macro attached to

unprotect the document
insert a field
protect the document

what is the code for "Insert Field" and how do I then create a button and
assign the macro?

Thanks xx
 
G

Greg Maxey

Sarah,

Where do you want this field added and what do you expect to happen if
the user clicks the button repeatedly?

The basic code is:

ActiveDocument.FormFields.Add (Range and Type)

Example:

Sub AddField
ActiveDocument.FormFields.Add Range:=Selection.Range,
Type:=wdFieldFormTextInput
End Sub

You could use a macrobutton field to call the macro.
 
S

Sarah_Lecturer

If the user clicks repeatedly I want multiple fields to be inserted.

Basically; I have a template which has form fields on it and these are fine.
the only issue is that some users may need more fields to add more
information to the template; so I am trying to give them this option without
allowing them to manually unprotect the document:


Sub FormsInsertFields()

' If document is protected, Unprotect it.
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:="fixstyles"
End If

' Insert a Field
Sub AddField()
ActiveDocument.FormFields.Add Range:=Selection.Range,
Type:=wdFieldFormTextInput
End Sub


' ReProtect the document.
If ActiveDocument.ProtectionType = wdNoProtection Then
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, _
NoReset:=True
End If

End Sub

Thanks for your help xx
 
G

Greg Maxey

You could try something like:

Sub FormsInsertFields()
Dim oRng As Word.Range
With ActiveDocument
If .ProtectionType <> wdNoProtection Then
.Unprotect Password:="fixstyles"
End If
Set oRng = .Range
With oRng
.Collapse wdCollapseEnd
.InsertAfter vbCr
.Move wdCharacter, 1
End With
.FormFields.Add Range:=oRng, Type:=wdFieldFormTextInput
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End With
End Sub


Use a MacroButton field to call it from the form.

{ MacroButton FormsInsertFields "Double-click to add formfield" }
 
C

Charles Kenyon

The method I've used is (with fields in a table row) I create an AutoText
entry containing the table row or multiple AutoText entries to hold various
fields. I then have my macro insert the row and fields by inserting the
AutoText. I find it easier to manually modify AutoText entries than it is to
recode.

Here is the code I use. It is not well documented, though, and I wouldn't be
much help in altering it because I'm not a programmer, just a lawyer who
tinkers. It works for me. Since the change can take place in one of three
different tables, there are different procedures depending on the table.

Sub AddTimeRow()
'
' AddTimeRow Macro
' Macro written 12/01/2003 by Charles Kyle Kenyon
' Revised 01/16/2004 by Charles Kyle Kenyon
' Additional comments added 04/28/2006 by Charles Kyle Kenyon
'
' Triggered by F2 key
'
UnprotectDocumentMacro
Dim sTime As String
sTime = ActiveDocument.Bookmarks("TotalIn").Range.Text
If sTime = "0.0" Then
sTime = ActiveDocument.Bookmarks("TotalOut").Range.Text
If sTime = "0.0" Then
ActiveDocument.Bookmarks("TimeTitle").Select
ProtectDocumentMacro
Exit Sub
End If
End If
' sTime section is checking for zero totals in table. The two places there
that could hold a total are bookmarked. It checks the contents of those
bookmarks. If they are both 0.0, then it goes to a bookmark in the table
header which is not a form field and reprotects the table. This acts to
select the first formfield in the table.
'
' Unprotected document
'
'
Application.ScreenUpdating = False
Dim oTemplate As Template
Set oTemplate = Templates(ThisDocument.FullName)
With Selection
.GoTo What:=wdGoToBookmark, Name:="Total1"
.MoveUp Unit:=wdLine, Count:=1
#If VBA6 Then
' Procedure for later versions
.InsertRowsBelow 1
.HomeKey Unit:=wdLine
#Else
' Procedure for Word 97
.InsertRows 1
.HomeKey Unit:=wdLine
.MoveDown Unit:=wdLine, Count:=1
.HomeKey Unit:=wdLine
.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.Extend
.EndKey Unit:=wdLine
.MoveRight Unit:=wdCharacter, Count:=3
.Copy
.Delete Unit:=wdCharacter, Count:=1
.MoveUp Unit:=wdLine, Count:=1
.Paste
.MoveDown Unit:=wdLine, Count:=1
#End If
' oAutoText("TimeLine").Insert
'
' Then it does the AutoCorrect settings - not sure why.
'
Application.DisplayAutoCompleteTips = True
With AutoCorrect
.CorrectInitialCaps = True
.CorrectSentenceCaps = True
.CorrectDays = True
.CorrectCapsLock = True
.ReplaceText = True
End With
' Then insert, one by one, the AutoText entries for each cell in the row.
Finally, it moves back to the beginning of the row and reprotect's the
document. This selects the form field at the beginning of the new row.
oTemplate.AutoTextEntries("zDateField").Insert Where _
:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeDescription").Insert _
Where:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeOutOfCourt").Insert _
Where:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeInCourt").Insert _
Where:=.Range
.MoveLeft Unit:=wdCell
.MoveLeft Unit:=wdCell
.MoveLeft Unit:=wdCell
End With
Application.ScreenUpdating = True
Application.ScreenRefresh
ProtectDocumentMacro
End Sub

Sub InsertRowAboveMe()
'
' InsertRowAboveMe Macro
' Macro written 12/01/03 by Charles Kyle Kenyon
'
' Unprotect document
UnprotectDocumentMacro
'
'
Dim sAutoTextEntry1 As String
Dim sAutoTextEntry2 As String
Dim oTemplate As Template
Set oTemplate = Templates(ThisDocument.FullName)
'
With Selection
.SelectRow
' Test for Table 2
' -------------------------Table 2 - Time -----------------
If ActiveDocument.Range(0,
Selection.Tables(1).Range.End).Tables.Count = 2 Then
' Test for time row (4 columns)
If .Columns.Count = 4 Then
'
'' Add row if in a table
' If Selection.Information(wdWithInTable) = True Then
' Selection.Rows.Add BeforeRow:=Selection.Rows(1)
' End If
.InsertRows 1
.HomeKey Unit:=wdLine
Application.DisplayAutoCompleteTips = True
With AutoCorrect
.CorrectInitialCaps = True
.CorrectSentenceCaps = True
.CorrectDays = True
.CorrectCapsLock = True
.ReplaceText = True
End With
oTemplate.AutoTextEntries("zDateField").Insert Where _
:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeDescription").Insert _
Where:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeOutOfCourt").Insert _
Where:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeInCourt").Insert _
Where:=.Range
.MoveLeft Unit:=wdCell
.MoveLeft Unit:=wdCell
.MoveLeft Unit:=wdCell
End If ' 4 Columns
End If ' Table 2
'
' Test for Table 3
' -------------------------Tables 3 & 4 -
Disbursements ----------------------
If ActiveDocument.Range(0,
Selection.Tables(1).Range.End).Tables.Count > 2 Then
If ActiveDocument.Range(0,
Selection.Tables(1).Range.End).Tables.Count = 3 Then
sAutoTextEntry1 = "zExpenseDescription"
sAutoTextEntry2 = "zExpenseAmount"
Else ' Table 4 - Payments
sAutoTextEntry1 = "zPaymentDescription"
sAutoTextEntry2 = "zPaymentAmount"
End If
' Test for entry row (3 columns)
If .Columns.Count = 3 Then
'
'' Add row if in a table
' If Selection.Information(wdWithInTable) = True Then
' Selection.Rows.Add BeforeRow:=Selection.Rows(1)
' End If
.InsertRows 1
.HomeKey Unit:=wdLine
Application.DisplayAutoCompleteTips = True
With AutoCorrect
.CorrectInitialCaps = True
.CorrectSentenceCaps = True
.CorrectDays = True
.CorrectCapsLock = True
.ReplaceText = True
End With
oTemplate.AutoTextEntries("zDateField").Insert Where _
:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries(sAutoTextEntry1).Insert _
Where:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries(sAutoTextEntry2).Insert _
Where:=.Range
.MoveLeft Unit:=wdCell
.MoveLeft Unit:=wdCell
End If ' 3 Columns
End If ' Table 3

End With ' Selection
ProtectDocumentMacro
End Sub

Sub AddExpenseRow()
'
' AddExpenseRow Macro
' Macro written 11/18/2003 by Charles Kyle Kenyon
'
UnprotectDocumentMacro
If ActiveDocument.Bookmarks("Disbursements").Range.Text = "$ 0.00" Then
ActiveDocument.Bookmarks("DisbursementsTitle").Select
ProtectDocumentMacro
Exit Sub
End If
' #If VBA6 Then
' With Selection
' .GoTo What:=wdGoToBookmark, Name:="Total2"
' .MoveUp Unit:=wdLine, Count:=1
' '
' ' Procedure for later versions
' .InsertRowsBelow 1
' .HomeKey Unit:=wdLine
' .MoveRight Unit:=wdCell
' .MoveRight Unit:=wdCell
' .TypeText Text:="0.00"
' .MoveLeft Unit:=wdCell
' .MoveLeft Unit:=wdCell
' End With
' NoBorders
' #Else
AddRow97 (3)
' #End If
ProtectDocumentMacro
End Sub

Sub AddPaymentRow()
'
' AddPaymentRow Macro
' Macro written 11/18/2003 by Charles Kyle Kenyon
'
UnprotectDocumentMacro
If ActiveDocument.Bookmarks("Payments").Range.Text = "$ 0.00" Then
ActiveDocument.Bookmarks("PaymentsCreditsTitle").Select
ProtectDocumentMacro
Exit Sub
End If
' #If VBA6 Then
' With Selection
' .GoTo What:=wdGoToBookmark, Name:="Payments"
' .MoveUp Unit:=wdLine, Count:=1
' .InsertRowsBelow 1
' .HomeKey Unit:=wdLine
' .MoveRight Unit:=wdCell
' .MoveRight Unit:=wdCell
' .TypeText Text:="0.00"
' .MoveLeft Unit:=wdCell
' .MoveLeft Unit:=wdCell
' End With
' NoBorders
' #Else
AddRow97 (4)
' #End If
ProtectDocumentMacro
End Sub

Sub UpdateTotals()
'
' UpdateTotals Macro
' Macro written 11/18/2003 by Charles Kyle Kenyon
'
UnprotectDocumentMacro
' ActiveDocument.Tables(5).Select
' With Selection
' .Fields.Update
' .Fields.Update
'' CheckDisbursements ' If hidden and not empty, unhide
' .GoTo What:=wdGoToBookmark, Name:="Balance"
' .MoveLeft Unit:=wdCell
' .Collapse
' End With
ActiveDocument.Bookmarks("SummaryTable").Range.Fields.Update
ActiveDocument.Bookmarks("BalanceTopRow").Range.Fields.Update
ProtectDocumentMacro
End Sub

Private Sub NoBorders()
'
' NoBorders Macro
' Macro written 11/19/2003 by Charles Kyle Kenyon
'
Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
With Selection.Cells
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
End With
Selection.HomeKey Unit:=wdLine
End Sub

Sub ShowHideDisbursements()
'
' ShowHideDisbursements Macro
' Macro written 11/24/03 by Charles Kyle Kenyon
' Toggles printing of disbursements category (Table 3)
'
UnprotectDocumentMacro
With Selection
.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=3, Name:=""
.MoveUp Unit:=wdLine, Count:=1
.EndKey Unit:=wdLine
.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.Extend
.GoTo What:=wdGoToBookmark, Name:="Disbursements"
.Font.Hidden = wdToggle
With .Find
.ClearFormatting
With .Font
.Name = "Comic Sans MS"
.Hidden = False
End With
.Replacement.ClearFormatting
With .Replacement.Font
.Name = "Comic Sans MS"
.Hidden = True
End With
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Replacement.ClearFormatting
End With
' .GoTo What:=wdGoToBookmark, Name:="DisbursementsSummary"
' .Font.Hidden = wdToggle
.GoTo What:=wdGoToBookmark, Name:="Disbursements"
.HomeKey Unit:=wdLine
.MoveUp Unit:=wdLine, Count:=1
End With
ProtectDocumentMacro
End Sub
'

Private Sub AddRow97(Optional lTable As Long = 2)
'
' AddRow97 Macro
' Macro recorded 11/24/03 by Charles Kyle Kenyon
'
Dim oTemplate As Template
Set oTemplate = Templates(ThisDocument.FullName)
Dim sAutoTextEntry1 As String
Dim sAutoTextEntry2 As String
If lTable = 3 Then
sAutoTextEntry1 = "zExpenseDescription"
sAutoTextEntry2 = "zExpenseAmount"
Else ' Table 4 - Payments
sAutoTextEntry1 = "zPaymentDescription"
sAutoTextEntry2 = "zPaymentAmount"
End If
'
Dim lRowCount As Long
Dim rRow As Range
UnprotectDocumentMacro
'
lRowCount = ActiveDocument.Range.Tables(lTable).Rows.Count
ActiveDocument.Tables(lTable).Rows(lRowCount - 1).Select
With Selection
.Copy
.Paste
ActiveDocument.Tables(lTable).Rows(lRowCount).Select
.Delete Unit:=wdCharacter, Count:=1
.HomeKey Unit:=wdLine
Application.DisplayAutoCompleteTips = True
With AutoCorrect
.CorrectInitialCaps = True
.CorrectSentenceCaps = True
.CorrectDays = True
.CorrectCapsLock = True
.ReplaceText = True
End With
oTemplate.AutoTextEntries("zDateField").Insert Where _
:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries(sAutoTextEntry1).Insert _
Where:=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries(sAutoTextEntry2).Insert _
Where:=.Range
.MoveLeft Unit:=wdCell
.MoveLeft Unit:=wdCell
ActiveDocument.Tables(lTable).Rows(lRowCount).Select
With .Cells
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With ' .Cells
End With ' Selection
ActiveDocument.Range.Tables(lTable).Rows(lRowCount).Select
Selection.HomeKey Unit:=wdLine
ProtectDocumentMacro
End Sub

Private Sub CheckDisbursements()
Dim lAmount As Variant
Dim rAmount As Range
Set rAmount = ActiveDocument.Bookmarks("Disbursements").Range
lAmount = rAmount.Text
' MsgBox Prompt:=lAmount
If lAmount <> "$ 0.00" Then
If rAmount.Font.Hidden = True Then
ShowHideDisbursements
MsgBox Prompt:="FYI: There is an amount (" & lAmount _
& ") in Disbursements." _
& vbCrLf & "Disbursements will print.", _
Title:="Disbursements Included in Totals"
End If
End If
End Sub


Sub UnprotectDocumentMacro()
' Unprotect document
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
End Sub

Sub ProtectDocumentMacro()
If ActiveDocument.ProtectionType <> wdAllowOnlyFormFields Then
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, noreset:=True
End If
End Sub

Sub RateChange()
frmRates.Show
End Sub
Sub DeleteRow()
'
' DeleteRow Macro
' Macro written 12/2/2003 by Charles Kyle Kenyon
'
Dim vResponse As Variant
Dim iTable As Integer
Dim iRows As Integer
vResponse = MsgBox(Prompt:="This will delete the row you are in!", _
Title:="Are you sure?", _
Buttons:=vbOKCancel)
If vResponse = vbOK Then
UnprotectDocumentMacro
If Selection.Information(wdWithInTable) = True Then
iTable = ActiveDocument.Range(0,
Selection.Tables(1).Range.End).Tables.Count
iRows = ActiveDocument.Tables(iTable).Rows.Count
If iTable = 2 Then
iRows = iRows - 1
End If
If iRows > 3 Then
Selection.Rows.Delete
Else
MsgBox Prompt:="This row cannot be deleted.", _
Title:="Sorry"
End If ' iRows > 3
End If ' within table
ProtectDocumentMacro
End If
End Sub

I use assigned function keys to trigger the macros. Directions are included
in a borderless text box that floats on top of text. The contents of the
text box are colored blue and set as hidden text. With our settings, the
user sees the instructions but they don't print or change the document
formatting.

Hope this is of some help.

--
Charles Kenyon

Word New User FAQ & Web Directory: http://addbalance.com/word

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide) http://addbalance.com/usersguide




--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

How to insert Certificated digital signature in Word for Mac 0
MS365 WORD: How to Create Macro Button to CLEAR ALL fields in fill-in form 1
Getting Radio Buttons to work, that are inserted via AutoText 0
Insert Multiple Fields without Dialog closing between each... 0
Adjusting the layout of over 1000 existing Word documents using a macro-driven batch run 0
Clearing Fields in a Word Form 5
Building Blocks and Macros 5
VBA - exporting serial letters to single documents 0

Top