The code to get all headings of a particular Style might look like:
Code:
Private Sub UserForm_Initialize()
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Style = wdStyleHeading1
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
cboContractForm.AddItem Split(.Range.Text, vbCr)(0)
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End Sub
In this case, the code will populate a dropdown with all "Heading 1" text - which is what you might use for 'Contract 1', 'Contract 2', etc.
Having chosen the contract, you might then use code like the following to get its items:
Code:
Sub Get_Items()
Dim Rng As Range
With ActiveDocument
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = cboContractForm.Value
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Style = wdStyleHeading1
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Set Rng = .Duplicate
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Style = wdStyleHeading2
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If .InRange(Rng) Then
'Code to populate checkbox captions goes here
Else
Exit Do
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End With
End Sub
and code like:
Code:
Sub Delete_Contracts()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Style = wdStyleHeading1
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If Split(.Text, vbCr) <> cboContractForm.Value Then
Set Rng = .Duplicate
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
Rng.Text = vbNullString
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End With
Application.ScreenUpdating = True
End Sub
to delete the unwanted headings.
Then, when you've selected the items, you might use code like the following to delete any unwanted items:
Code:
Sub Delete_Items()
Application.ScreenUpdating = False
Dim Ctrl As Control, StrItems As String, Rng As Range
For Each Ctrl In Me.Controls
With Ctrl
If .Name Like "ContractItem#*" Then
If .Value = 0 Then
If .Caption = "" Then
StrItems = StrItems & "|" & .Caption & "|"
End If
End If
End If
End With
Next
MsgBox StrItems
Exit Sub
With ActiveDocument
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Style = wdStyleHeading2
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If InStr(StrItems, "|" & Split(.Text, vbCr) & "|") > 0 Then
Set Rng = .Duplicate
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
Rng.Text = vbNullString
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End With
Application.ScreenUpdating = True
End Sub
The above assumes the checkboxes are named ContractItem1, ContractItem2, etc.