Re: Table in a Form

Does this work to add a new row to the end of a table? Or will it insert a
row beneath the current row no matter where in the current table the user is
at?

Does this insert a blank row? Or is it a copy/paste (duplicate) of the
previous?

"Charles Kenyon" wrote:

> 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").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 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" <HiDbLevel@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
> news:3A2D23B4-7C1B-4C79-B5B8-1682C58591ED@xxxxxxxxxxxxxxxx
> > 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" <HiDbLevel@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
> >> news:3443B509-C1E4-4780-A4D5-2AD4DDAD79FD@xxxxxxxxxxxxxxxx
> >> > 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" <HiDbLevel@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
> >> >> news:38133409-4712-43D6-A4CF-0B366ED8D5E8@xxxxxxxxxxxxxxxx
> >> >> >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.
> >> >>
> >> >>
> >> >>
> >>
> >>
> >>
>
>
>
.

Loading