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

Anonimowe

2022-11-17T09:31:49+00:00

Zamieniłem sobie plik normal w Word i zaczęło ponownie działać. Nie mam pojęcia gdzie mógł być błąd 🙄

Co do Twojego pomysłu, żeby zrobić narzędzie do takiej zmiany to fajny pomysł. Ja na pewno bym to kupił.

Wiele osób nie ma pojęcia, że można korzystać przy wykresach z opcji "Wstaw podpis" a potem wygenerować "Spis ilustracji". I ludzie ręcznie podpisują tabele, wykresy, zdjęcia. Więc Twoje narzędzie automatyzujące to byłoby interesującym rozwiązaniem. Ja bym kupił :)

zwracam tylko uwagę, że przy tym kodzie, który wysłałeś, jeżeli tabela jest w formie zdjęcia, to kod "wciąga" to zdjęcie do stylu tytułu tabeli. W moim przypadku był to head7 i zgodnie z tym stylem jest formatowany akapit ze zdjęciem.

P.S. jeśli zrobisz narzędzie na VBATools to skrobnij prywatnie na maila :)

P.S2. W przyszłym tygodniu piwo leci do Ciebie 😃🍻

Dziękuję za pomoc. Jak zwykle jesteś niezawodny 😃🤩
Czy ta odpowiedź była pomocna?

Komentarze: 0 Brak komentarzy