Microsoft Office Forums - View Single Post

gmaxey · 06-12-2016, 07:13 AM

Paul,

I suppose someone may move the goal post and add text after the CC in the cell as well.

Code:

Sub Demo()
Dim oCC As ContentControl, oRng As Range
  For Each oCC In ActiveDocument.ContentControls
    With oCC
      If .Range.Information(wdWithInTable) = True Then
        Set oRng = .Range
        oRng.Start = oRng.Start - 1
        oRng.End = oRng.End + 1
        ActiveDocument.Bookmarks.Add .Title, oRng
      End If
    End With
  Next
  Application.ScreenUpdating = True
End Sub

silverspr,

While you may have a method working using fields and conditionals, if you are going to use Content Controls, then why not take full advantage of them?

If you have your five CCs uniquely titled, why not map them to a customXMLPart and use the document CC OnExit Event to perform the calculation:

Code:

Private Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
Dim oXMLPart As CustomXMLPart
Dim oNode As CustomXMLNode, oSumNode As CustomXMLNode
Dim sngSum As Single
  Set oXMLPart = oCC.XMLMapping.CustomXMLPart
  For Each oNode In oXMLPart.DocumentElement.ChildNodes
    If oNode.BaseName <> "Sum" Then 'Change Sum to whatever CC title you used for the CC set to display the summed values.
      If IsNumeric(oNode.Text) Then sngSum = sngSum + oNode.Text
    Else
      Set oSumNode = oNode
    End If
  Next
  oSumNode.Text = sngSum
lbl_Exit:
  Exit Sub
End Sub

You can quickly map CCs in any document using my CC Tools Add-In:
http://gregmaxey.com/word_tip_pages/...rol_tools.html

or use:

Code:

Sub MapYourDocumentCCs()
Dim oXMLPart As Office.CustomXMLPart
Dim oNode As CustomXMLNode
Dim oCC As ContentControl
  On Error Resume Next
  'Keep parts from piling up if you rerun the code.
  Set oXMLPart = ActiveDocument.CustomXMLParts.SelectByNamespace("http://Greg_Maxey/Demo").Item(1)
  oXMLPart.Delete
  On Error GoTo 0
  Set oXMLPart = ActiveDocument.CustomXMLParts.Add("<?xml version='1.0' encoding='utf-8'?><Root xmlns='http://Greg_Maxey/Demo'></Root>")
    For Each oCC In ActiveDocument.ContentControls
      'Currently no conditions. You can set conditions here e.g., If oCC.Tag = "Map me" etc.
      oXMLPart.AddNode oXMLPart.DocumentElement, Replace(oCC.Title, " ", "_"), , , msoCustomXMLNodeElement
      oCC.XMLMapping.SetMapping oXMLPart.DocumentElement.LastChild.xPath
    Next oCC
lbl_Exit:
  Exit Sub
End Sub