Word 2019 Macro execution very slow

Question

We have been using Word macros to create labels since Office XP.

Text is distributed in table cells. For example, a table on an A4 sheet has 11x27 cells.
The macros were migrated from Word XP to Word 2010 and now we have Word 2019.
The execution of the macros has been unbearably slow since 2019.

Measurements from today

• 15 year old PC with Windows, Office XP: 8 seconds
• 5 year old PC with Office 2010: 2 seconds
• 1 year old PC Windows 10, Office 2019 44 seconds

(we have> 20 PCs with Office 2019 and it's like this or worse for all of them)

The macro inserts the desired text into the individual cells one after the other.
Our macros are digitally signed with a trustworthy internal certificate.
Does anyone have any ideas how this can be improved?

Answer 1

Hi
Thanks for replay

this is a part of the code:

    Dim ScreenUpdate As CScreenUpdate
    Set ScreenUpdate = New CScreenUpdate

    bFlag = 1
    nSnCount = 0
    nLabelCount = 0
    While (bFlag Or (nSnCount < nMaxCountNo))

        Dim strCurrNo As String

        If (0 = bFlag) Then
            WordBasic.NextCell
        End If

        strCurrNo = WordBasic.[LTrim$](str(nStartNo + nSnCount))

        EingabeZeile astrZeile(1), anLenZeile(1), anPosNo(1), strCurrNo, _
                    MyDlg.Bold1, MyDlg.Italic1, MyDlg.Under1, _
                    MyDlg.Absatz1

        EingabeZeile astrZeile(2), anLenZeile(2), anPosNo(2), strCurrNo, _
                    MyDlg.Bold2, MyDlg.Italic2, MyDlg.Under2, _
                    MyDlg.Absatz2

        EingabeZeile astrZeile(3), anLenZeile(3), anPosNo(3), strCurrNo, _
                    MyDlg.Bold3, MyDlg.Italic3, MyDlg.Under3, _
                    MyDlg.Absatz3

        nLabelCount = nLabelCount + 1

        If (nLabelCount >= nLabelCountNo) Then
            nLabelCount = 0
            nSnCount = nSnCount + 1
        End If

        bFlag = WordBasic.NextCell()
    Wend

Ende:
End Sub
' ***********************************************
Private Sub EingabeZeile(strZeile As String, _
                        nLenZeile As Long, _
                        nPosNo As Long, _
                        strCurrNo As String, _
                        fBold, _
                        fItalic, _
                        aUnder, _
                        aAbsatz)

    If (0 <> nLenZeile) Then
        WordBasic.FormatFont _
                    Bold:=fBold, _
                    Italic:=fItalic, _
                    Underline:=aUnder
        WordBasic.FormatParagraph Alignment:=aAbsatz
        If (0 <> nPosNo) Then
            WordBasic.Insert WordBasic.[Left$](strZeile, nPosNo - 1) + strCurrNo + _
                    WordBasic.[Right$](strZeile, Len(strZeile) - nPosNo)
        Else
            WordBasic.Insert strZeile
        End If
    End If

End Sub

I know this code is old but it works fine until Word 2010.

Is there a simple way to identify witch part need time?

Answer 2

I agree with John. WordBasic commands have been deprecated.

In addition, though, why are you using a macro for this when Mail Merge does it very easily?

https://support.office.com/en-us/article/mail-merge-using-an-excel-spreadsheet-858c7d7f-5cc0-4ba1-9a7b-0a948fa3d7d3

You could fairly easily write a macro to use mail merge if you need to.

Answer 3

Hi
Thank You for Your response
Mail Merge is no solution. The text changes on every run.
Now I write a new macro without WordBasic and it is also slow.

Sub Makro1()
tiStart = Now
Application.ScreenUpdating = False
For i = 1 To 170

    Selection.Font.Bold = True
    Selection.Font.Italic = False
    Selection.Font.Underline = wdUnderlineNone

    Selection.TypeText Text:="Zeile1"
    Selection.TypeParagraph

    Selection.Font.Bold = False
    Selection.Font.Italic = True
    Selection.Font.Underline = wdUnderlineNone

    Selection.TypeText Text:="Zeile2"
    Selection.TypeParagraph

    Selection.Font.Bold = False
    Selection.Font.Italic = False
    Selection.Font.Underline = wdUnderlineSingle

    Selection.TypeText Text:="Zeile3"
    Selection.MoveRight Unit:=wdCell

Next
Application.ScreenUpdating = True
tiEnd = Now

Call MsgBox("Zeit " & Format((tiEnd - tiStart), "Long Time"))

End Sub

Do you know an improvement to speedup as with Word 2010 (2 seconds)?
Thanks

Answer 4

Hi John
Thanks for your sample

I run your code an a table with 170 cells (10x17).

Word 2019 33 Seconds (1 year old computer)
Word 2010 2 Seconds (10 year old computer)

Can you test on your computer as a refernce?

So the problem is inside Word 2019

Answer 5

Hi John

For correction
First test was on a 11x27 table.
for simplify now it is only a 10x17 table.
This explain the speedup for 33%

I tried to use range object instead.

But I didn't find a solution to insert three lines with different format in a cell.
The format was always for the hole cell.

Do you have a tip to use ranges for three lines with different format.