Duplicate page and clear content controls

[toekneedee]

I have a word macro enabled document with various content controls. What I would like to do is copy page 1 and insert it as the 1st page. Then I want to clear the contents of the 10 rich text content controls. The other content controls should be left as copied.

This is a daily status form which the user would run the macro to start a new page for the day. The checklist items (plain text, date picker, check box content controls) are copied from the previous day and the comments area (rich text content control) is cleared for current notes.

Thanks,
Tony

[gmaxey]

How can you copy page 1 and then insert it as the 1st page?

If you wrap your first page CCs in a bookmark named bmCCs then this will do what you want (I think):


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 9/7/2017
Dim oRng As Word.Range
Dim oCC As ContentControl
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseEnd
oRng.InsertBreak wdPageBreak
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseEnd
ActiveDocument.Bookmarks("bmCCs").Range.Copy
oRng.Paste
For Each oCC In oRng.ContentControls
If oCC.Type = 0 Then oCC.Range.Text = vbNullString
Next
lbl_Exit:
Exit Sub
End Sub

[macropod]

How can you copy page 1 and then insert it as the 1st page?
Like this:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, CCtrl As ContentControl
With ActiveDocument
If .Range.Characters.First.Information(wdWithInTable) = True Then
.Range.Characters.First.InsertBreak wdColumnBreak
.Range.Characters.First.InsertBefore vbCr & Chr(12)
Else
.Range.InsertBefore vbCr & Chr(12)
End If
Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=2)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
With Rng
If .Characters.Last = Chr(12) Then
.End = .End - 1
End If
End With
.Range.Characters.First.FormattedText = Rng.FormattedText
Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=1)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
For Each CCtrl In Rng.ContentControls
With CCtrl
Select Case .Type
Case wdContentControlCheckBox: .Checked = False
Case wdContentControlRichText, wdContentControlText, wdContentControlDate: .Range.Text = ""
Case wdContentControlDropdownList
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDropdownList
Case wdContentControlComboBox
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlComboBox
End Select
End With
Next
End With
Application.ScreenUpdating = True
End Sub
Note that I've included all except picture content controls.

[gmaxey]

Paul, I read that the OP did not want CCs (other that rich text CCs) cleared.

[toekneedee]

gmaxey the macro works fine except it needs to copy the most recently inserted page not the original. So it works as a running checklist of what's been completed. Does that make sense?

Also that's correct I only want the rich text CC's content cleared for now, but what's the type for a date picker control that I may clear in the future?

[macropod]

The code in post #3 does what you want; simply omit the Case references to any CCtrl types you don't want to process.

[toekneedee]

macropod the macro works great (after changing it to only clear the CC's I needed) except for adding an extra page break following the first run of the macro. Is there any way to fix that?

[gmaxey]

Sub Demo()
Dim Rng As Range, CCtrl As ContentControl
'Adapted from Paul's code
Application.ScreenUpdating = False
With ActiveDocument
If .Range.Characters.First.Information(wdWithInTable) = True Then
.Range.Characters.First.InsertBreak wdColumnBreak
.Range.Characters.First.InsertBefore vbCr & Chr(12)
Else
.Range.InsertBefore vbCr & Chr(12)
End If
Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=2)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
.Range.Characters.First.FormattedText = Rng.FormattedText
Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=1)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
For Each CCtrl In Rng.ContentControls
If CCtrl.Type = wdContentControlRichText Then CCtrl.Range.Text = ""
Next
End With
Application.ScreenUpdating = True
End Sub

[macropod]

Code in post #3 edited. try it now.

[toekneedee]

Works exactly as I had it in my head! You guys are awesome! Thanks