OK - here are the macros called to add rows or delete rows to one of three
tables. They are triggered by function keys but you could use a custom
toolbar just as well.
' Copyright 2003 Charles Kyle Kenyon All rights reserved
'
'
Sub AddTimeRow()
'
' AddTimeRow Macro
' Macro written 12/01/2003 by Charles Kyle Kenyon
' Revised 01/16/2004 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
' 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
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").Inse rt _
Whe=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeOutOfCourt").Inser t _
Whe=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeInCourt").Insert _
Whe=.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").Inse rt _
Whe=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeOutOfCourt").Inser t _
Whe=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries("zTimeInCourt").Insert _
Whe=.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 _
Whe=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries(sAutoTextEntry2).Insert _
Whe=.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.Te xt = "$ 0.00" Then
ActiveDocument.Bookmarks("DisbursementsTitle").Sel ect
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").S elect
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.Fie lds.Update
ActiveDocument.Bookmarks("BalanceTopRow").Range.Fi elds.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).Sele ct
.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 _
Whe=.Range
.MoveRight Unit:=wdCell
oTemplate.AutoTextEntries(sAutoTextEntry2).Insert _
Whe=.Range
.MoveLeft Unit:=wdCell
.MoveLeft Unit:=wdCell
ActiveDocument.Tables(lTable).Rows(lRowCount).Sele ct
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 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
Note, I wrote these a long time ago, with help. Lots of code is commented
out. I am sending that to show what didn't work. The code also checks for
Word 97 and runs a different macro in some cases for Word97.
Each of the add macros actually first checks to see if anything has already
been input in the table. If not, it just goes to the first row of the table
for input.
AutoText entries hold a row with the appropriate formfields. This is a lot
easier (for me) than trying to create the fields using vba.
You would add your password in the protect and unprotect macros. You would
want to password protect your code as well to protect your password.
Hope this gets you started.
--
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
See also the MVP FAQ:
http://www.mvps.org/word which is awesome!
--------- --------- --------- --------- --------- ---------
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.
"HiDbLevel" wrote in message
...
Sorry for the mix up there...Yes I am dealing with a protected form using
fields from the forms toolbar. And because it is protected, the user
won't
be able to just press tab at the end of the table. I understand it is a
long
process, any help you could provide would be greatly appreciated.
"Charles Kenyon" wrote:
Pressing the tab key in the last cell of the form automatically adds a
row.
--
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
See also the MVP FAQ: http://www.mvps.org/word which is awesome!
--------- --------- --------- --------- --------- ---------
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.
"HiDbLevel" wrote in message
...
My question isn't a matter of protecting the form, I understand how to
lock
out a form, it's a question of setting up Word to automatically add a
row
onto a table as the table is used, an automation.
"Charles Kenyon" wrote:
Protected form with formfields from the forms toolbar?
--
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
See also the MVP FAQ: http://www.mvps.org/word which is awesome!
--------- --------- --------- --------- --------- ---------
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.
"HiDbLevel" wrote in message
...
I have created a form for other users to use, and in it I would like
to
have
a way of automatically inserting a new/fresh row in the table so as
to
allow
for multiple entries. Due to the nature of the form, I can't just
have
twenty rows just ready to go, I need to somehow have rows created as
the
user
needs them.