High Freddi,

using the assumptions from my former posting,
except that there are two ranges instead of one:

Sub Macro2()
Dim lPos As Long
Dim rDcm As Range
Dim rTmp As Range
Set rDcm = ActiveDocument.Range
Set rTmp = ActiveDocument.Range
With rDcm.Find
  .Style = "Heading 2"
  While .Execute
     Set rTmp = rDcm.Paragraphs.Last.Next.Range
     rTmp.Select ' redundant, for testing only
     lPos = rTmp.Start
     With rTmp.Find
        .Text = "."
        If .Execute Then
           rTmp.SetRange Start:=lPos, End:=rTmp.End
           rTmp.Select ' redundant, for testing only
           rTmp.Font.Bold = True
           rTmp.Font.Italic = True
        End If
     End With
  Wend
End With
End Sub