Excel продолжает работать медленно, используя SmartArtLayout в VBA?

Question

Excel зависает при запуске этого кода, есть ли способ остановить это?или даже заставляя его заморозить на меньшее время.Код генерирует умную художественную иерархию

Sub Org()
'
' Org Macro
'
    Dim ogSALayout As SmartArtLayout
    Dim QNode As SmartArtNode
    Dim QNodes As SmartArtNodes
    Dim t As Integer
    Set ogSALayout = Application.SmartArtLayouts(105) 'reference to organization chart
    Set ogShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout)
    Set QNodes = ogShp.SmartArt.AllNodes
    t = QNodes.Count

    While QNodes.Count < t
    QNodes(QNodes.Count).Delete
    Wend

    While QNodes.Count < Range("A1").End(xlDown).Row
    QNodes.Add.Promote
    Wend

    For i = 1 To Range("A1").End(xlDown).Row
    'Promote and demote nodes to put them at the proper level.

    While QNodes(Range("A" & i)).Level < Range("C" & i).Value
        QNodes(Range("A" & i)).Demote
    Wend

    'Copy the cell text to the node.
    QNodes(Range("A" & i)).TextFrame2.TextRange.Text = Range("B" & i)
    Next i

End Sub

Answer 1

Это может помочь:

 Sub Org()
 Application.Screenupdating = False

 'the rest of your code

 Application.Screenupdating = True
 End Sub