Почему мой макрос VBA разделяет только первую и третью части документа Word? - PullRequest
Новая
       17

Почему мой макрос VBA разделяет только первую и третью части документа Word?

0 голосов
/ 04 апреля 2019

У меня есть макрос, который берет один документ Word, копирует данные в мои параметры и затем вставляет его в несколько отдельных документов (в данном случае три).

Это первый раз, когда используется VBA, поэтому, пожалуйста, не спешите.

Исходный документ представляет собой длинный документ с несколькими повторяющимися разделами. Заполнив исходный документ, пользователь может сэкономить время, заполнив один, а не три почти идентичных документа. Я разделил оригинал на три части. Мой код берет данные из первого объявленного раздела и вставляет их в новый документ. Это также работает для третьего. Второй, однако, не работает.

The 

With R.Find
.Text = "START OF FORM*^12"
.MatchWildcards = True

раздел ищет текст «Начало формы» и принимает его и остальное содержимое вплоть до «^ 12» (что, я считаю, относится к разрыву страницы).

Документ составлен таким образом, что каждый раздел документа начинается с этого текста и заканчивается разрывом страницы. 

Sub DocSplit()

' Declares variable (in this case R).
Dim R As Range

' Sets R to the active document, being a number of ranges (will be defined later).
Set R = ActiveDocument.Range.Duplicate

'  You won't be able to see what the macro is doing, but will run quicker.
Application.ScreenUpdating = False

' For R, find text with whatever is in the " marks.
With R.Find
.Text = "START OF FORM*^12"
.MatchWildcards = True

' Runs a series of statements as long as given conditions are true. While it's doing this,
While .Execute

' Copy and saves contents of R.
CopyAndSave R

' While ends.
Wend

'With ends.
End With

' Collapses range to the ending point.
R.Collapse wdCollapseEnd

' Returns or sets the ending character position of a range.
R.End = R.Parent.Range.End
CopyAndSave R

End Sub
Static Sub CopyAndSave(R As Range)

' Declares D as document.
Dim D As Document

' Represents the number of words in the collection.
' Long is a datatype for values too large for "integer".
Dim Count As Long
Count = Count + 1

' Copies R from previous Sub to a new document.
R.Copy
Set D = Documents.Add

' Pastes range, preserving original formatting.
D.Range.PasteAndFormat wdFormatOriginalFormatting


D.SaveAs R.Parent.Path & Application.PathSeparator & _
"F00" & Count, wdFormatDocument
D.Close

End Sub

Я ожидал, что будут созданы три документа, F001, F002 и F003. Я получаю два файла, один из которых содержит первый раздел (как и предполагалось), а другой - два последних.

1 Ответ

0 голосов
/ 04 апреля 2019

Я быстро взглянул на ваш код и обнаружил следующие ошибки:

  • Если вы хотите, чтобы counter увеличивался при каждом вызове функции, вы должны объявить ее в основной функции, иначе она будет терять память при каждом вызове.
  • R.Find нужен аргумент. Если вы хотите получить более подробную информацию, посмотрите здесь
  • R.End нужен аргумент, здесь вы найдете несколько подсказок, в зависимости от того, что вам нужно сделать.

Я обновил некоторые части вашего кода, чтобы помочь вам: 

Sub DocSplit()

    ' Declares variable (in this case R).
    Dim R As Range

    ' Represents the number of words in the collection.
    ' Long is a datatype for values too large for "integer".
    Dim count As Long
    count = 0

    ' Sets R to the active document, being a number of ranges (will be defined later).
    Set R = ActiveDocument.Range.Duplicate

    '  You won't be able to see what the macro is doing, but will run quicker.
    Application.ScreenUpdating = False

    ' For R, find text with whatever is in the " marks.
    With R.Find("Text your're searching")
        .Text = "START OF FORM*^12"
        .MatchWildcards = True

        ' Runs a series of statements as long as given conditions are true. While it's doing this,
        While .Execute

            ' Copy and saves contents of R.
            Call CopyAndSave(R, count)

        ' While ends.
        Wend

    'With ends.
    End With

    ' Collapses range to the ending point.
    R.Collapse wdCollapseEnd

    ' Returns or sets the ending character position of a range.
    R.End = R.Parent.Range.End
    Call CopyAndSave(R)

End Sub
Static Sub CopyAndSave(R As Range, count As Long)
    ' Declares D as document.
    Dim D As Document

    count = count + 1

    ' Copies R from previous Sub to a new document.
    R.Copy
    Set D = Documents.Add

    ' Pastes range, preserving original formatting.
    D.Range.PasteAndFormat wdFormatOriginalFormatting


    D.SaveAs R.Parent.Path & Application.PathSeparator & _
    "F00" & count, wdFormatDocument
    D.Close

End Sub

Если у вас есть какие-либо сомнения, не стесняйтесь спрашивать.

...