Макрос для вставки нумерации в название таблицы

[artemcx]

Добрый день!

Имеется куча таблиц вида:

Таблица №
_________
_________
_________

Надо после каждого "№" вставить номера по порядку.

[Пименов Александр]

Вот самый простой макрос:

Public Sub TableNum()
Dim Table As Table, Caption As CaptionLabel
    On Error Resume Next
    Set Caption = CaptionLabels("Таблица №")
        If Err.Number > 0 Then
            CaptionLabels.Add Name:="Таблица №"
        End If
    For Each Table In ActiveDocument.Tables
        Table.Range.InsertCaption Label:="Таблица №", TitleAutoText:= _
            "InsertCaption1", Title:="", Position:=wdCaptionPositionAbove, _
            ExcludeLabel:=0
    Next Table
End Sub

[artemcx]

Дело в том, что он вставляет "Таблица №1" например после существующей надписи.

Вот так получается:

Таблица № - Название
Таблица №1

По другому пробывал, та же штука...Получается надо в сам текст сквозную нумерацию.

[artemcx]

Сообщение от Пименов Александр

Вот самый простой макрос:

Public Sub TableNum()
Dim Table As Table, Caption As CaptionLabel
    On Error Resume Next
    Set Caption = CaptionLabels("Таблица №")
        If Err.Number > 0 Then
            CaptionLabels.Add Name:="Таблица №"
        End If
    For Each Table In ActiveDocument.Tables
        Table.Range.InsertCaption Label:="Таблица №", TitleAutoText:= _
            "InsertCaption1", Title:="", Position:=wdCaptionPositionAbove, _
            ExcludeLabel:=0
    Next Table
End Sub

Дело в том, что он вставляет "Таблица №1" например после существующей надписи.

Вот так получается:

Таблица № - Название
Таблица №1

По другому пробывал, та же штука...Получается надо в сам текст нумерацию.

[shanemac51]

получился приличный слон, но у меня работает
--допускает повторное применение
--проверяет строку на шаблон
---------------------пробуйте на копии

Sub w140517_1023()
Dim S1, S2, s1a, J1, J1K, j1t, j1p, j2
j1t = Word.ActiveDocument.Tables.Count
j1p = Word.ActiveDocument.Paragraphs.Count
Debug.Print j1t, j1p
j2 = 2
Do While j1p > 0
With Word.ActiveDocument.Paragraphs(j1p)
If .Range.Information(wdWithInTable) = True Then
j2 = 0
S2 = .Range.Text & S2
Else
j2 = j2 + 1
    If j2 = 1 Then
    .Range.Select
    S1 = .Range.Text
    S1 = Replace(S1, Chr(13), "")
    S1 = Replace(S1, Chr(10), "")
    J1 = InStr(S1, "№")
    Debug.Print Len(S1), J1, S1; "="
    
        If J1 = 0 Then
        MsgBox "таблица не имеет опорной строки " & Mid(S2, 1, 100)
        S2 = ""
        Else
        S2 = ""
        J1K = J1 + 1
        Do While J1K < Len(S1)
            If InStr("0123456789 ", Mid(S1, J1K, 1)) > 0 Then
            .Range.Characters(J1K).Text = "`"
            Else
            Exit Do
            End If
        J1K = J1K + 1
        Loop
        Do While J1K > J1
            If .Range.Characters(J1K).Text = "`" Then
            .Range.Characters(J1K).Text = ""
            End If
        J1K = J1K - 1
        Loop
        
        .Range.Characters(J1).Text = "№" & j1t & " "
        End If
    
    
    j1t = j1t - 1
    End If
End If
End With
j1p = j1p - 1
Loop
End Sub

[artemcx]

Программа работает, спасибо! Но есть минус, для большого количества таблиц (около 10 000) работает очеееень долго. 100 таблиц в файле нумерует минут 30....

На ошибку не обращайте внимания

[shanemac51]

у вас похоже неразрешены макросы на вкладке параметры-безопасность

правда у меня 2007
но каких-то особых строк я не применяла

[artemcx]

С ошибкой разобрался, все работает.


Для большого количества таблиц (около 10 000) работает очеееень долго. 100 таблиц в файле нумерует минут 30....

[artemcx]

Вот что-то похожее должно получится, но ничего не происходит. Что посоветуете изменить (добавить)?

Sub qwer ()
Dim i As Long
Do
i = i + 1
Loop While ThisDocument.Range.Find.Execute(Fin dtext:="Таблица № ", replacewith:="Таблица №" + CStr(i))

End Sub

[shanemac51]

10000 таблиц---- сколько же это страниц
задача явно не для ворда

--если структура одинакова --excel
--иначе НТМ с оглавлением и навигацей


====
таблицы имеют объединенные ячейки или нет