#1
|
|||
|
|||
Using macro to add variable number of rows to a protected word table
Hi there, I am trying to add a row or rows to a table in a protected word document. I have created the following macro that unprotects the document, adds the row, copies some drop-down fields into the row and then re-enforces the protection.
Sub Macro2() ' ' Macro2 Macro ' ' ActiveDocument.Unprotect Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveDown Unit:=wdLine, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.InsertRows 1 Selection.Collapse Direction:=wdCollapseStart Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.TypeText Text:="2" Selection.MoveUp Unit:=wdLine, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=2 Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend Selection.Copy Selection.MoveDown Unit:=wdLine, Count:=1 Selection.PasteAndFormat (wdPasteDefault) Selection.MoveUp Unit:=wdLine, Count:=1 If ActiveDocument.ProtectionType = wdNoProtection Then ActiveDocument.Protect _ Type:=wdAllowOnlyFormFields, NoReset:=True End If End Sub My issue is that I would like to run this macro (and other macros that add more lines) based on a number selected by the user in a drop-down box. i.e. User selects #of items : '3' from a drop-down box. Based on the fact that '3' was selected, I want 3 rows added to the table. It appears that I can only choose one macro to run on exit of the field, and not have a range of macros that are run based on the users selection. Can anyone offer some assistance with this? Thanks :-) |
#2
|
|||
|
|||
Something like this:
Code:
Sub NewMultiRow() Dim pTable As Word.Table Dim bValid As Boolean Dim curCursor As Long Dim bCalcField As Boolean Dim oRng1 As Word.Range Dim oRng2 As Word.Range Dim userInput As String Dim rowsToAdd As Long Dim rowAdd As Long Dim oFF As Word.FormField Dim oRowID As Long Dim i As Long Dim pNewName As String Dim pNameSeparator As Long Dim pRowIndex Dim oBmName As String Set pTable = ActiveDocument.Tables(1) 'As appropriate 'Use Selection.Tables(1) if executing with an on exit macor 'Get user input of rows to add bValid = False Do userInput = InputBox("Enter number of rows to add", "Add Rows", 1) If userInput = vbNullString Then Exit Sub If userInput = "0" Then Exit Sub If IsNumeric(userInput) Then rowsToAdd = CLng(userInput) If rowsToAdd > 0 Then bValid = True If Not bValid Then MsgBox "You must use a positve numeric input e.g." & Chr(34) & "3" & Chr(34) End If Loop Until bValid 'Minimize screen flicker curCursor = System.Cursor System.Cursor = wdCursorWait Application.ScreenUpdating = False 'Determine if calculation fields are present and set a flag On Error GoTo Err_Handler Set oRng1 = pTable.Rows(pTable.Rows.Count - 2).Range '2 accounts for the trailing rows bCalcField = False For i = 1 To oRng1.FormFields.Count If oRng1.FormFields(i).TextInput.Type = wdCalculationText Then bCalcField = True Exit For End If Next i 'Unprotect document. If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then ActiveDocument.Unprotect End If 'Add individual rows For rowAdd = 1 To rowsToAdd Set oRng1 = pTable.Rows(pTable.Rows.Count - 2).Range Set oRng2 = oRng1.Duplicate With oRng1 .Copy .Collapse Direction:=wdCollapseEnd .Paste End With For i = 1 To oRng1.FormFields.Count oRowID = pTable.Rows.Count - 4 '4 accounts for the two leading and two 'trailing. 'Build and assign formfield bookmark names oRng1.FormFields(i).Select 'Build new name pNewName = oRng2.FormFields(i).Name pNameSeparator = InStr(pNewName, "_Row") If pNameSeparator > 0 Then pNewName = Left(pNewName, pNameSeparator - 1) End If 'Prevent assigning an existing bookmark name If ActiveDocument.Bookmarks.Exists(pNewName & "_Row" & oRowID) Then MsgBox "Invalid action. A form field with the bookmark name " _ & pNewName & "_" & oRowID _ & " already appears this table. Exiting this procedure." pTable.Rows(oRowID).Delete ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True Exit Sub End If With Dialogs(wdDialogFormFieldOptions) .Name = pNewName & "_Row" & oRowID 'Assign valid bookmark name to new formfield .Execute End With 'This code could be used to clear previous on exit macros if used. 'If oRng2.FormFields(i).ExitMacro = "NewMultiRow" Then ' oRng2.FormFields(i).ExitMacro = "" 'End If Next 'Call subroutine to build new calculation field If bCalcField Then BuildNewCalcFieldExpressions oRng1, oRng2 End If Next pRowIndex = pTable.Rows.Count - rowsToAdd + 1 - 2 '2 accounts for the 2 trailing rows oBmName = pTable.Rows(pRowIndex).Cells(1).Range.Bookmarks(1).Name ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True 'Restore visuals Application.ScreenUpdating = True System.Cursor = curCursor Exit Sub Err_Handler: If Err.Number = 5991 Then MsgBox Err.Description Else MsgBox "Unknown error." End If End Sub Sub BuildNewCalcFieldExpressions(ByVal oRng1 As Range, oRng2 As Range) 'Construct any new calculation fields. Credit for this section goes to fellow 'MVP Tony Jollans Dim oFF As FormField Dim strOldVar As String Dim strNewVar As String Dim strNewCalc As String Dim ndx As Long Dim ndx2 As Long Dim lngVarPosit As Long Dim lngVarNextPosit As Long Dim bVariableFound As Boolean Dim bVariableReplace As Boolean For ndx = 1 To oRng1.FormFields.Count Set oFF = oRng1.FormFields(ndx) If oFF.Type = wdFieldFormTextInput Then If oFF.TextInput.Type = wdCalculationText Then strNewCalc = oFF.TextInput.Default For ndx2 = 1 To oRng2.FormFields.Count strOldVar = oRng2.FormFields(ndx2).Name lngVarPosit = 1 Do While lngVarPosit > 0 lngVarPosit = InStr(lngVarPosit, strNewCalc, strOldVar) bVariableFound = lngVarPosit > 0 bVariableReplace = bVariableFound If bVariableReplace Then If lngVarPosit > 1 Then If Mid$(strNewCalc, lngVarPosit - 1) Like "[0-9A-Z_a-z]" Then bVariableReplace = False End If End If End If If bVariableReplace Then lngVarNextPosit = lngVarPosit + Len(strOldVar) If lngVarNextPosit <= Len(strNewCalc) Then If Mid$(strNewCalc, lngVarNextPosit) Like "[0-9A-Z_a-z]" Then bVariableReplace = False End If End If End If If bVariableReplace Then strNewVar = oRng1.FormFields(ndx2).Name strNewCalc = Left$(strNewCalc, lngVarPosit - 1) & strNewVar & Mid$(strNewCalc, lngVarNextPosit) lngVarPosit = lngVarPosit + Len(strNewVar) Else If bVariableFound Then lngVarPosit = lngVarPosit + Len(strOldVar) End If End If Loop Next ndx2 oFF.Select With Dialogs(wdDialogFormFieldOptions) .TextDefault = strNewCalc .Execute End With End If End If Next ndx End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Mail Merge to create specific number of table rows | flackend | Mail Merge | 4 | 12-01-2023 02:49 PM |
Allow user to add rows to Word '03 table....how? | PMR | Word Tables | 2 | 05-18-2012 06:16 AM |
Help with VBA macro - Variable input | sc30317 | Excel Programming | 0 | 08-31-2011 01:00 PM |
adding rows to word table | hklein | Word VBA | 4 | 07-18-2011 12:21 AM |
Fixing number or rows in a table | burnsie | Word | 2 | 07-12-2011 02:59 AM |