Выполнение кода, запись в документ Word с использованием VBA

Question

У меня есть массив строк (15000,2) (прибл.), И с помощью кода ниже я записываю строки в документ Word.Код становится все медленнее и медленнее, чем больше «строк» ​​массива я записал в документ.Для массива (1000,2) ок.Требуется 4 минуты, для массива (2000,2) ок.20 минут нужно.Моя проблема в том, что я не знаю, как сделать код быстрее.

Обновление экрана отключено.

'Go through every "row" of the array arrDatenGefiltert
For RowIndex = 0 To lngRowIndex_arrDatenGefiltert
    'If the value of the array at the actual "row" and first "column" is not empty...
    If Not arrDatenGefiltert(lngRowIndex_arrDatenGefiltert, 0) = "" Then
        'Write the content of the actual "row" of the array in the document
        With ThisDocument
            'Write the content of the actual "row" and the first "column" in the document
            With .Paragraphs(.Paragraphs.Count).Range
                .Text = arrDatenGefiltert(RowIndex, 0)
                ''Some formatting
                .Font.Size = 11
                .Font.Bold = False
            End With
            'New Paragraph at the end of the document
            .Paragraphs.Add
            'If the second "column" entry is not empty
            If Not arrDatenGefiltert(RowIndex, 1) = "" Then
                'Write the content of the actual "row" and the second "column" in the document
                With .Paragraphs(.Paragraphs.Count).Range
                    .Text = arrDatenGefiltert(RowIndex, 1)
                    'Some formatting
                    .Font.Size = 12
                    .Font.Bold = True
                End With
                'New Paragraph at the end of the document
                .Paragraphs.Add
            End If
            ''Write the content of the actual "row" and the thrid "column" in the document
            With .Paragraphs(.Paragraphs.Count).Range
                .Text = arrDatenGefiltert(RowIndex, 2)
                'Some formatting
                .Font.Size = 12
                .Font.Bold = False
            End With
            'New paragraph at the end of the document
            .Paragraphs.Add
            'Write an additional line at the end of the document (which is the same for every "row" of the array)
            With .Paragraphs(.Paragraphs.Count).Range
                .Text = "*****************"
                'Some formatting
                .Font.Size = 12
                .Font.Bold = False
            End With
            'New paragraph at the end of the document
            .Paragraphs.Add
        End With
    End If
Next RowIndex
'Some formatting for the whole document
ThisDocument.Range(0, 0).Select
Selection.WholeStory
With Selection
    .Font.Color = wdColorBlack
    .Font.Italic = False
    .Font.Name = "Calibri"
    .Font.Underline = wdUnderlineNone
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
End With

Answer 1

Вот мой скорректированный код с предложениями Синди Мейстер.Я пошел на шаг дальше и записал весь текст в строку, включая абзацы - «знаки», и записал его оттуда в документе Word.Форматирование я сделал потом:

        '''Write the whole content from the strings in the array arrDatenGefiltert in the string strContent
        'For each "row" of the array
        For RowIndex = 0 To lngRowIndex_arrDatenGefiltert
            'If the first "column" of the array is not empty
            If Not arrDatenGefiltert(lngRowIndex_arrDatenGefiltert, 0) = "" Then
                'Write the first "column" of the actual "row" of the array in the string; before, add some unique characters
                strContent = strContent & "%$!First!" & arrDatenGefiltert(RowIndex, 0) & vbCr
                'If the second "column" of the actual "row" of the array is not empty
                If Not arrDatenGefiltert(RowIndex, 1) = "" Then
                    'Write the second "column" of the actual "row" of the array in the string; before, add also some unique characters
                    strContent = strContent & "%$!Second!" & arrDatenGefiltert(RowIndex, 1) & vbCr
                End If
                'Write the third "column" of the actual "row" of the array in the string; before, add also some unique characters
                strContent = strContent & "%$!Thrid!" & arrDatenGefiltert(RowIndex, 2) & vbCr
                ''Write an additional line
                strContent = strContent & "*****************" & vbCr
            End If
        Next RowIndex

        '''Write the value of the string strContent in the Word document
        ActiveDocument.Range(0, 0).Text = strContent

Вот пример для определения стиля;Я определил три из них.Два других очень похожи на этот:

    Sub DefineStyleFirst()

        WordBasic.FormatStyle Name:="StyleFirst", NewName:="", BasedOn:="", NextStyle:="", Type:=0, FileName:="", link:=""
        WordBasic.FormatStyle Name:="StyleFirst", NewName:="", BasedOn:="", NextStyle:="", Type:=0, FileName:="", link:=""

        With ActiveDocument.Styles("StyleFirst").Font
            .Name = "Calibri"
            .Size = 11
            .Bold = False
            .Italic = False
            .Underline = wdUnderlineNone
            .UnderlineColor = wdColorAutomatic
            .StrikeThrough = False
            .DoubleStrikeThrough = False
            .Outline = False
            .Emboss = False
            .Shadow = False
            .Hidden = False
            .SmallCaps = False
            .AllCaps = False
            .Color = wdColorAutomatic
            .Engrave = False
            .Superscript = False
            .Subscript = False
            .Scaling = 100
            .Kerning = 0
            .Animation = wdAnimationNone
        End With

        With ActiveDocument.Styles("StyleFirst").ParagraphFormat
            .LeftIndent = CentimetersToPoints(0)
            .RightIndent = CentimetersToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 10
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceMultiple
            .LineSpacing = LinesToPoints(1.15)
            .Alignment = wdAlignParagraphLeft
            .WidowControl = True
            .KeepWithNext = False
            .KeepTogether = False
            .PageBreakBefore = False
            .NoLineNumber = False
            .Hyphenation = True
            .FirstLineIndent = CentimetersToPoints(0)
            .OutlineLevel = wdOutlineLevelBodyText
            .CharacterUnitLeftIndent = 0
            .CharacterUnitRightIndent = 0
            .CharacterUnitFirstLineIndent = 0
            .LineUnitBefore = 0
            .LineUnitAfter = 0
            .MirrorIndents = False
            .TextboxTightWrap = wdTightNone
        End With

        ActiveDocument.Styles("StyleFirst").NoSpaceBetweenParagraphsOfSameStyle = False
        ActiveDocument.Styles("StyleFirst").ParagraphFormat.TabStops.ClearAll

        With ActiveDocument.Styles("StyleFirst").ParagraphFormat

            With .Shading
                .Texture = wdTextureNone
                .ForegroundPatternColor = wdColorAutomatic
                .BackgroundPatternColor = wdColorAutomatic
            End With

            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleNone
            .Borders(wdBorderBottom).LineStyle = wdLineStyleNone

            With .Borders
                .DistanceFromTop = 1
                .DistanceFromLeft = 4
                .DistanceFromBottom = 1
                .DistanceFromRight = 4
                .Shadow = False
            End With
        End With

        ActiveDocument.Styles("StyleFirst").NoProofing = False
        ActiveDocument.Styles("StyleFirst").Frame.Delete

    End Sub

Просто вызывается в коде, как этот;сразу после заполнения строки strContent:

        DefineStyleFirst
        DefineStyleSecond
        DefineStyleThird

После всех этих шагов, наконец, происходит форматирование текста:

        'For each element of the collection "Paragraphs" 
        For Each Element In ActiveDocument.Paragraphs
            'If the first characters of the paragraph are "%$!First!"
            If Left(Element.Range.Text, 9) = "%$!First!" Then
                'The Style of the paragraph is set to "StyleFirst"
                Element.Style = "StyleFirst"
                'Delete the first characters of the paragraph
                Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 9)
            End If
            'If the first characters of the paragraph are "%$!Second!"
            If Left(Element.Range.Text, 10) = "%$!Second!" Then
                'The Style of the paragraph is set to "StyleSecond"
                Element.Style = "StyleSecond"
                'Delete the first characters of the paragraph
                Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 10)
            End If
            'If the first characters of the paragraph are "%$!Third!"
            If Left(Element.Range.Text, 9) = "%$!Third!" Then
                'The Style of the paragraph is set to "StyleThird"
                Element.Style = "StyleThird"
                'Delete the first characters of the paragraph
                Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 9)
            End If
            'If the first characters of the paragraph are "*****************"
            If Left(Element.Range.Text, 17) = "*****************" Then
                'The Style of the paragraph is set to "StyleThird"
                Element.Style = "StyleThird"
            End If
        Next Element

Answer 2

Я вижу несколько способов помочь, просто взглянув на код:

1. Кажется, контент должен быть добавлен в конце документа?Вместо использования .Paragraphs(.Paragraphs.Count).Range - что приведет к снижению производительности для каждого . - создайте объект Range и работайте с ним.

Например:

Dim rngEndOfDoc as Word.Range
Set rngEndOfDoc = ActiveDocument.Content
rngEndOfDoc.Collapse wdCollapseEnd
'Add new content here
rngEndOfDoc.Text = "something"
'Collapse it each time new content should be added with different formatting
rngEndOfDoc.Collapse wdCollapseEnd

Для всего текста с одинаковым форматированием не используйте Paragraphs.Add для добавления нового абзаца.Вместо этого объедините новый абзац в строку, используя vbCr.

Например:

arrDatenGefiltert(RowIndex, 1) & vbCr & arrDatenGefiltert(RowIndex, 2)

Это не столько производительность, сколько правильное использование: не используйте ThisDocument, если вы явно не собираетесь ссылаться только на документ, который содержит код макроса.Вместо этого используйте ActiveDocument или, что еще лучше, объявите и создайте экземпляр объекта Document (и с помощью этого будет быстрее).

Пример:

Dim doc as Word.Document
Set doc = ActiveDocument

With doc

Вместо многократного применения нескольких действий прямого форматирования, используйте Стили , которые уже содержат команды форматирования.Если код использует шаблон (а не создает новый документ по умолчанию), определите стили в шаблоне, чтобы новые документы, созданные из него, наследовали стили.В противном случае определите стили с помощью кода - применение стилей будет быстрее И . Это позволит избежать возможных сообщений об ошибках, когда Word не хватает памяти для сохранения такого большого количества отдельных команд форматирования (для возможных действий отмены).