View Single Post
 
Old 04-17-2019, 03:03 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote