Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 01-25-2020, 10:44 AM
gmaxey gmaxey is offline Add Rows to table that will include content controls of previous rows Windows 10 Add Rows to table that will include content controls of previous rows Office 2016
Word MVP 2003-2009
 
Join Date: May 2010
Location: Marble, NC
Posts: 1,007
gmaxey will become famous soon enoughgmaxey will become famous soon enough
Default

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
ThisDocument Module:


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
Attached Files
File Type: docm MacroPods Inspection Form Revised.docm (54.4 KB, 3 views)
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #17  
Old 01-25-2020, 02:44 PM
macropod's Avatar
macropod macropod is offline Add Rows to table that will include content controls of previous rows Windows 7 64bit Add Rows to table that will include content controls of previous rows Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,060
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Hi Greg,

Thanks for investigating. I agree that seems to be the culprit - and can be deleted in this case - but I still don't understand why it's causing that behaviour.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #18  
Old 01-25-2020, 02:49 PM
macropod's Avatar
macropod macropod is offline Add Rows to table that will include content controls of previous rows Windows 7 64bit Add Rows to table that will include content controls of previous rows Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,060
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Quote:
Originally Posted by gmaxey View Post
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.
Thanks Greg - I'll take a look. Also, the OP may find having a button on the QAT a useful alternative.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #19  
Old 01-25-2020, 03:43 PM
gmaxey gmaxey is offline Add Rows to table that will include content controls of previous rows Windows 10 Add Rows to table that will include content controls of previous rows Office 2016
Word MVP 2003-2009
 
Join Date: May 2010
Location: Marble, NC
Posts: 1,007
gmaxey will become famous soon enoughgmaxey will become famous soon enough
Default

That event has been buggy since it's inception. I thought it was resolved with Word 2010, but sometimes it appears and disappears. It can cause havoc when it happens.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #20  
Old 01-25-2020, 08:52 PM
macropod's Avatar
macropod macropod is offline Add Rows to table that will include content controls of previous rows Windows 7 64bit Add Rows to table that will include content controls of previous rows Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,060
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Thanks Greg. Code in document attached to post #9 updated.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #21  
Old 01-27-2020, 08:00 AM
bobsagat bobsagat is offline Add Rows to table that will include content controls of previous rows Windows 8 Add Rows to table that will include content controls of previous rows Office 2016
Novice
Add Rows to table that will include content controls of previous rows
 
Join Date: Jan 2020
Posts: 12
bobsagat is on a distinguished road
Default

Wow guys! Thanks so much for your time. I was away and came back to all of your responses. Once again I appreciate all of the help.
Everything seems to be working perfectly now!
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Add Rows to table that will include content controls of previous rows Delete rows with content controls baes10 Word VBA 2 12-13-2017 10:12 AM
Add Rows to table that will include content controls of previous rows Include multiple (but varying in number) Excel rows in each separate email mrjimi Mail Merge 3 12-10-2017 09:45 AM
Add Rows to table that will include content controls of previous rows 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
Add Rows to table that will include content controls of previous rows Grouping table rows to prevent individual rows from breaking across pages dennist77 Word 1 10-29-2013 11:39 PM


All times are GMT -7. The time now is 11:44 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2020, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2020 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft