See
http://word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm.
What you are trying to do is complex. It is probably not the place to start
learning vba.
What follows is my code for adding rows to different tables in an invoice.
The fields are stored in the template as AutoText entries. (It is possible
to store an entire table row as an AutoText entry as well.) I find that for
me it is easier to create fields manually and store them as AutoText, then
insert them using code than it is to create them using code.
It is a mish-mash, I'm afraid, but it may help you
get started. We prefer if there are no expenses or payments, to hide those
tables altogether. The various procedures are called using keyboard
shortcuts. Those shortcuts are shown in a floating borderless textbox and
set to be hidden text (which is displayed but doesn't print). The form
starts with one data entry row in each table. The procedures check the
balance for a table and if it is 0, they go to the already inserted data
entry position. If it is not 0, it is assumed that the table has already
been used. Then it inserts a row, populates it with blank fields and moves
to the first inserted field.
This may be too much of kludge for you. I'm sure there are more effecient
ways of doing this. I suspect that I use AutoText to populate the rows
because I never took the time to learn how to write formfields using code.
On the other hand, if one wants to make changes, AutoText is easier to
change (for me) than is code.
Option Explicit
' 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 FontsBigger()
UnprotectDocumentMacro
ActiveDocument.Styles("Body Text,bt,bt1").Font.Size = 12
ActiveDocument.Styles("Heading 2").Font.Size = 12
ActiveDocument.Styles("Subtitle").Font.Size = 14
ProtectDocumentMacro
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
You'll notice that I commented out much of the conditionally compiled code.
I think I discovered it wasn't needed, but it has been a long time since I
did this. It could be that we just no longer have any Word97 machines
around. I'm not sure why it messes with the AutoCorrect settings. I've used
it without problems for a couple of years now.
I won't be much more help in figuring this out, though. I'm a lawyer, not a
programmer. Hope it gives you a leg up.
--
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.
