Таблицу в отдельный файл

[Balexander]

Добрый день. В документе Word есть несколько таблиц. Они с произвольный количеством строк, но заведомо известно, что у них 5 столбцов.
Как эти таблицы записать каждую в свой отдельный вордовый файл?

И еще никак не могу решить небольшую задачку: просматриваю в документ в цикле от1 до номера последнего параграфа. Как на i-м параграфе организовать поиск ", 2" и замену этой комбинации на ", (406) 2". Потом в этом же параграфе найти ": 19" и заменить это на ": (407) 19"

[forumWord]

у них 5 столбцов.

При чём здесь столбцы?

[Balexander]

Т.к. я, к сожалению, не особо силен в программировании, то указал это число на всякий случай. Может быть это нужная информация

[forumWord]

Balexander, пока вот так придумал:

Sub Макрос1()
Dim oTable As Table
Dim oNewDocument As Word.Document
Dim vCounter As Long
For vCounter = 1 To ActiveDocument.Tables.Count
    ActiveDocument.Tables(vCounter).Range.Copy
    Set oNewDocument = Documents.Add(Visible:=False)
    With oNewDocument
        .SaveAs FileName:="C:\Таблица № " & vCounter
        .Range.Paste
        .Save
        .Close
    End With
Next
End Sub

[Balexander]

Огромное спасибо!
Все заработало. Сейчас сформирую названия файлов и выбор пути. И эта часть будет сделана. Еще раз спасибо.

Может быть вы дадите подсказочку по второму вопросу?

[forumWord]

Sub Макрос1()
Dim vCounter As Long
For vCounter = 1 To ActiveDocument.Paragraphs.Count
    If vCounter = "указывается номер нужного абзаца" Then
        ActiveDocument.Paragraphs(vCounter).Range.Find.Execute findtext:=", 2", replacewith:=", (406) 2", Replace:=wdReplaceAll
        ActiveDocument.Paragraphs(vCounter).Range.Find.Execute findtext:=": 19", replacewith:=": (407) 19", Replace:=wdReplaceAll
    End If
Next
End Sub

[Balexander]

Прошу прощения, но тут еще всплыло действие после замены в конкретном абзаце.
Нужно в конце этого абзаца дописать "(415)"

И еще нужно удалить все абзацы из документа в которых присутствует слово "Аналогичные".

Я еще только на начальном пути изучения VBA, а нужно срочно обработать кучу огромных файлов. Без макроса я буду это делать до майских праздников
Спасибо!

[forumWord]

Только примитивный способ придумал:

Sub Макрос1()
Dim vCounter As Long
Dim myRange As Range
For vCounter = 1 To ActiveDocument.Paragraphs.Count
    If vCounter = "указывается номер нужного абзаца" Then
        ActiveDocument.Paragraphs(vCounter).Range.Find.Execute findtext:=", 2", replacewith:=", (406) 2", Replace:=wdReplaceAll
        ActiveDocument.Paragraphs(vCounter).Range.Find.Execute findtext:=": 19", replacewith:=": (407) 19", Replace:=wdReplaceAll
        ActiveDocument.Paragraphs(vCounter).Range.Select
        Selection.EndKey
        Selection.Text = "(415)"
    End If
Next
End Sub

И ещё вот так:

Sub Макрос1()
Dim oParagraph As Paragraph
For Each oParagraph In ActiveDocument.Paragraphs
    If InStr(oParagraph, "Аналогичные") > 0 Then
        oParagraph.Range.Delete
    End If
Next
End Sub

[Balexander]

Огромное спасибо!