VBA Word - numerowanie tabel

Mam problem z makro w Word. Może ktoś poprawi to makro, które nie działa w pełni tak jak powinno. Już tłumaczę o co chodzi.

W pliku Worda mam tabele podpisane jako "Tabela. [Nazwa tabeli]." Tabele nie są automatycznie numerowane, tak aby potem można było zrobić ich spis. Postanowiłem więc spróbować zrobić makro działające w taki sposób, aby:

1. Wszystkie akapity zaczynające się od "Tabela. zmieniały formatowanie stylu właściwego dla podpisu tabeli.
2. Słowa "Tabela. " zostały zastąpione na "Tabela [nr]. ", gdzie [nr] jest automatycznym, kolejnym numerem tabeli w dokumencie.

O ile udało mi się osiągnąć pkt. 1 to mam problem z pkt. 2 :(

Po zastosowaniu poniższego makro formatuje mi zgodnie ze stylem wszystkie akapity, które zaczynają się od "Tabela. ". Ale niestety tylko pierwsze występowanie słowa tabela jest numerowane na zasadzie "Tabela 1." a w pozostałych przypadkach makro usuwa słowa "Tabela. " i nie wstawia podpisu z automatycznym numerowaniem :( Nie potrafię niestety rozwiązać tego problemu. Będę bardzo wdzięczny za pomoc

Sub Change_Tabel()

Dim objDoc As Document

Dim head7 As Style

Set objDoc = ActiveDocument

Set head7 = ActiveDocument.Styles("Podpis nad obiektem")

With objDoc.Content.Find

.ClearFormatting

.Text = "Tabela. "

.MatchWildcards = True

With .Replacement

.ClearFormatting

.Style = head7

End With

.Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll

End With

With objDoc.Content.Find

.ClearFormatting

    Options.ReplaceSelection = True

ActiveDocument.Sentences(1).Select

.Execute FindText:="Tabela. "

.MatchWildcards = True

If .Found = True Then

Selection.Delete Unit:=wdCharacter, Count:=1

Selection.InsertCaption Label:=wdCaptionTable, TitleAutoText:="", \_

    Title:="", Position:=wdCaptionPositionAbove, ExcludeLabel:=0

Selection.TypeText Text:="." & vbTab

End If

.Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll

End With

End Sub