VBA Word - numerowanie tabel

Anonimowe

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:

Wszystkie akapity zaczynające się od "Tabela. zmieniały formatowanie stylu właściwego dla podpisu tabeli.
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

Pytanie zablokowane. To pytanie zostało zmigrowane ze społeczności pomocy technicznej firmy Microsoft. Możesz zagłosować, czy pytanie jest pomocne, ale nie możesz dodawać komentarzy ani odpowiedzi, ani też śledzić pytania.

Komentarze: 0

Odpowiedź zaakceptowana przez autora pytania

Oskar Shon 49,336 Moderator wolontariuszy

No, dobra :P

Sub Tabele_spis_ilustracji()
'MVP Oskar Shon www.VBATools.pl dodatki do Office
Dim p As Paragraph, i%, t$
Dim head7 As Style: Set head7 = ActiveDocument.Styles("Podpis nad obiektem")
For Each p In ActiveDocument.Paragraphs
    With p.Range
      t = Trim(.Text)
      If t Like "Tabela*" And Len(t) > 6 And Not t Like "Tabela #*" Then
         i = i + 1
         .Text = ""
         .Select
         Selection.InsertCaption Label:="Tabela", TitleAutoText:="InsertCaption1", _
            Title:=". " & Trim(Mid(t, 7)), Position:=0, ExcludeLabel:=0
         Selection.Style = head7
      End If
    End With
Next
End Sub

No i wyszło tak:

Pozdrawiam.

Komentarze: 0

Dodatkowe odpowiedzi: 17

Oskar Shon 49,336 Punkty reputacji Moderator wolontariuszy

2022-11-16T21:13:02+00:00

Przepisałem dokładnie obrazek z pow.

Sam nie mam tego Stylu jak chciałeś użyć u siebie, więc zrobiłem obejście aby go nie stosować ale to tyle, u ciebie powinien działać na tamtym dokumencie.

Sam kod działa jak trzeba, wiec coś innego musi być u ciebie przeszkodą:

Podwójna kropka to linijka którą możesz zmodyfikować.

Numerowanie się samo robi bo zasugerowałeś aby je tworzyć, a tworzy się samo jak użyje się wstawienie podpisu.

Ale text zostaje jak powinien.

Pozdrawiam
Czy ta odpowiedź była pomocna?

Komentarze: 0 Brak komentarzy
Anonimowe

2022-11-16T20:53:48+00:00

Kurcze, ucina mi tytuły wykresów :/

przed zastosowaniem makro mam tak:

A po zastosowaniu makro tak:

W przypadku poprzedniego makro (bez automatycznej numeracji nie ucina tekstu po "Tabela nr":
Czy ta odpowiedź była pomocna?

Komentarze: 0 Brak komentarzy
Oskar Shon 49,336 Punkty reputacji Moderator wolontariuszy

2022-11-16T20:45:57+00:00

Piotrek, napisz mi dlaczego od razu nie wstawiałeś odsyłaczy?

Nie wiedziałeś ile będzie tabel, a potem po skasowaniu jednej nie działa poprawienie numerowania...

bo pomyślałem aby to przekuć na toola (szerszy niż tylko tabele), ale może to nie jest jakiś problem który można w ten sposób wykorzystać.

No i zamknij post wskazując odpowiedź :)

bo w sumie zrobione tak aby dawało spis tabel.

Pozdrawiam.
Czy ta odpowiedź była pomocna?

Komentarze: 0 Brak komentarzy
Anonimowe

2022-11-16T18:39:32+00:00
Niestety to nie do końca jest to :/ Numery się zgadzają, ale nie są to aktywne numery tabel, które pozwolą skorzystać z funkcji "Wstaw spis ilustracji" :(

Jeśli korzystam z nagrywania makro w Word i korzystam z funkcji: "Wstaw podpis" i tam wstawiam podpis do tabeli to mam taki kod:
```
Selection.InsertCaption Label:="Tabela", TitleAutoText:="InsertCaption1", \_ 

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

Selection.TypeText Text:="." & vbTab
```
Dziękuję Ci za zaangażowanie. piwo oczywiście wyślę, ale z tego makro nie skorzystam, bo jak mam 200 tabel w dokumencie to i tak wszystko będę musiał zmieniać ręcznie, żeby potem stworzyć spis tabel ze stronami.
Czy ta odpowiedź była pomocna?

Komentarze: 0 Brak komentarzy