![]() |
|
|
|
#1
|
|||
|
|||
|
Paul, I've taken some liberties with your project and wanted to share them with you. I am not getting the double firing of the Exit event. First, I've split the code between the ThisDocument module and a standard module call mode main. I've added a button to the QAT to insert a new row after the selected row. Standard module code: Code:
Option Explicit
Sub SandwichNewRow()
InsertRowWithContent Selection.Information(wdEndOfRangeRowNumber)
End Sub
Sub InsertRowWithContent(lngRowIndex As Long)
Dim lngLastRowIndex As Long
Dim oTbl As Table
Dim oRng As Range
Set oTbl = Selection.Tables(1)
Application.ScreenUpdating = False
With oTbl.Range
lngLastRowIndex = .Cells(.Cells.Count).RowIndex
With .Rows(lngRowIndex).Range
If lngRowIndex = lngLastRowIndex Then
'Append row at end of table
.Characters.Last.Next.InsertBefore vbCr
Else
'Insert row after current row
On Error GoTo Err_Adjust
Set oRng = .Characters.Last.Next
'Note: Error occurs if a content control is the first character in the following row.
oRng.InsertBreak wdColumnBreak
On Error GoTo 0
End If
Adjust_RE:
.Characters.Last.Next.FormattedText = .FormattedText
End With
End With
InitializeNewRow Selection.Tables(1), lngRowIndex + 1
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
Err_Adjust:
oRng.InsertBefore " "
oRng.End = oRng.End - 1
oRng.InsertBreak wdColumnBreak
oRng.Characters.Last.Next.Delete
Resume Adjust_RE
End Sub
Sub InitializeNewRow(oTbl As Table, lngIndex As Long)
Dim oCC As ContentControl
Dim bLocked As Boolean, bLockContent As Boolean
'Reset all content controls in the designated row
With oTbl.Rows(lngIndex).Range
For Each oCC In .ContentControls
With oCC
bLocked = .LockContentControl: bLockContent = .LockContents
.LockContentControl = False: .LockContents = False
Select Case .Type
Case 8: .Checked = False
Case wdContentControlPicture
If Not .ShowingPlaceholderText Then
If .Range.InlineShapes.Count > 0 Then .Range.InlineShapes(1).Delete
End If
Case wdContentControlRichText, wdContentControlText, wdContentControlDate: .Range.Text = ""
Case wdContentControlDropdownList
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDropdownList
Case wdContentControlComboBox
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlComboBox
End Select
.LockContentControl = bLocked: .LockContents = bLockContent
End With
Next
End With
lbl_Exit:
Exit Sub
End Sub
Code:
Option Explicit
Private Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
Dim oDoc As Document
Dim oTbl As Table
Dim lngPType As Long, lngDDLE As Long
Const constPW = "" 'Insert password (if any) here
Set oDoc = ActiveDocument
On Error Resume Next
Set oTbl = oDoc.Tables(1)
If Not oTbl Is Nothing Then
lngPType = oDoc.ProtectionType
If lngPType <> wdNoProtection Then oDoc.Unprotect constPW
Application.ScreenUpdating = False
With oCC
Select Case .Title
Case "Description"
For lngDDLE = 1 To .DropdownListEntries.Count
If .DropdownListEntries(lngDDLE).Text = .Range.Text Then
With .Range.Rows(1).Cells(3).Range.ContentControls(1)
.LockContents = False
.Range.Text = oCC.Range.Text
.LockContents = True
End With
Exit For
End If
Next lngDDLE
Case Else
If oCC.Range.InRange(oTbl.Rows.Last.Cells(oTbl.Rows.Last.Cells.Count).Range) Then
If MsgBox("Do you want to add a new row?", vbQuestion + vbYesNo, "ADD ROW") = vbYes Then
modMain.InsertRowWithContent oCC.Range.Rows(1).Index
End If
End If
End Select
End With
'Re-protect the document, if applicable
oDoc.Protect lngPType, constPW
Application.ScreenUpdating = True
End If
lbl_Exit:
Set oDoc = Nothing: Set oTbl = Nothing
Exit Sub
End Sub
|
|
#2
|
||||
|
||||
|
Thanks Greg - I'll take a look. Also, the OP may find having a button on the QAT a useful alternative.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
| Thread Tools | |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
Delete rows with content controls
|
baes10 | Word VBA | 2 | 12-13-2017 10:12 AM |
Include multiple (but varying in number) Excel rows in each separate email
|
mrjimi | Mail Merge | 3 | 12-10-2017 09:45 AM |
Duplicating one or more table rows or an entire table with content controls
|
kevinbradley57 | Word VBA | 10 | 08-17-2017 02:13 PM |
| Content Controls - Add Table Rows | dgiromini | Word VBA | 1 | 04-11-2014 03:04 PM |
Grouping table rows to prevent individual rows from breaking across pages
|
dennist77 | Word | 1 | 10-29-2013 11:39 PM |