question

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?

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.

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

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

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.