Good morning good people of the internet!
I am using the following code to add a new report section to a report. This report needs to be added when there's multiple subjects to a report. Problem lies when someone accidentally adds a new section without meaning to, and there's no way to remove it because everything is locked down.
Can someone assist me with adding a permission (Do you want to add a new row? Dialog) to this code?
I didn't write this code myself, but found it somewhere.
Any help would be greatly appreciated!!
Code:
Sub AddRow()
'Run on exit from the last form field in
'the last row of the table
Dim oTable As Table
Dim oRng As Range
Dim oNewRow As Range
Dim oCell As Range
Dim oLastCell As Range
Dim sResult As String
Dim iRow As Long
Dim iCol As Long
Dim CurRow As Long
Dim i As Long, j As Long
Dim sPassword As String
Application.ScreenUpdating = False
Dim RngSel As Range, RngSrc As Range, RngTgt As Range
Dim FmFld As FormField, Prot As Variant
If MsgBox("Add new row?", vbQuestion + vbYesNo) = vbYes Then
Set RngSel = Selection.Cells(1).Range.FormFields(1).Range
With ActiveDocument
Prot = .ProtectionType
If .ProtectionType <> wdNoProtection Then
Prot = .ProtectionType
.Unprotect Password:=sPassword
End If
sPassword = ""
'password to protect/unprotect form
With ActiveDocument
.Unprotect Password:=sPassword
'Unprotect document
Set oTable = Selection.Tables(1)
'Establish which table the cursor is in
For j = 1 To .Tables.Count
If oTable.Range.Start = .Tables(j).Range.Start Then
'Table is j
Exit For 'Stop checking
End If
Next j
'Select the appropriate table
iCol = oTable.Columns.Count 'Record the last column number
'Set a range to the last cell0
Set oLastCell = oTable.Cell(iRow, iCol).Range
'Record the last cell field value
Select Case oLastCell.FormFields(1).Type
Case 70 'wdFieldFormTextInput
sResult = oLastCell.FormFields(1).Result
Case 71 'wdFieldFormCheckBox
sResult = oLastCell.FormFields(1).CheckBox.Value
Case 83 'wdFieldFormDropDown
sResult = oLastCell.FormFields(1).DropDown.Value
End Select
'Get the value in the last cell
Set oRng = oTable.Rows.Last.Range
'Add the last row to a range
Set oNewRow = oTable.Rows.Last.Range 'Add the last row to another range
oNewRow.Collapse wdCollapseEnd 'Collapse the second range to the end of the table
oNewRow.FormattedText = oRng
'insert the content of the last row into the new range
'thereby adding a new row with the same content as the last row
CurRow = oTable.Rows.Count 'Determine the new last row of the table
For i = 1 To iCol 'Repeat for each column
Set oCell = oTable.Cell(CurRow, i).Range 'process each cell in the row
oCell.FormFields(1).Select 'Select the first field in the cell
With Dialogs(wdDialogFormFieldOptions) 'and name it
.Name = "Tab" & j & "Col" & i & "Row" & CurRow 'eg Tab1Col1Row2
.Execute 'apply the changes
End With
Next i
'Select the formfield in the last cell of the previous row
oLastCell.FormFields(1).Select
'Remove the macro
oLastCell.FormFields(1).ExitMacro = ""
'Restore the field value according to type
Select Case oLastCell.FormFields(1).Type
Case 70
oLastCell.FormFields(1).Result = sResult
Case 71
oLastCell.FormFields(1).CheckBox.Value = sResult
Case 83
oLastCell.FormFields(1).DropDown.Value = sResult
End Select
.Protect NoReset:=True, _
Password:=sPassword, _
Type:=wdAllowOnlyFormFields
'Reprotect the form
.FormFields("Tab" & j & "Col1Row" _
& CurRow).Select 'and select the next field to be completed
End With
lbl_Exit:
Set oTable = Nothing
Set oRng = Nothing
Set oNewRow = Nothing
Set oCell = Nothing
Set oLastCell = Nothing
Exit Sub
End With
End If
End Sub