Codigo VBA não funciona com While

[Daniel Arruda]

Pessoal quando introduzo o While no seguinte codigo, ele não funciona.

Mas sem o While ele funciona normalmente.

Alguém sabe a razao ou como reparar?

O codigo serve para desenhar um retangulo dentro do AutoCad.

Eu queria desenhar diversos retangulos

 Option Explicit
    Sub DrawRectange()
        Dim AutocadApp As Object
        Dim SectionCoord(0 To 9) As Double
        Dim Topbar As Integer
        Dim BottomBar As Integer
        Dim Cover As Integer
        Dim Rectang As Object
        Dim ActDoc As Object
        Dim InsertP(2) As Double
        Dim CirObj As Object
        Dim i As Long
        '****** Launch Autocad application****
        On Error Resume Next
          Set AutocadApp = GetObject(, "Autocad.application")
        On Error GoTo 0
        If AutocadApp Is Nothing Then
             Set AutocadApp = CreateObject("Autocad.application")
             AutocadApp.Visible = True
        End If
         ''****Read Input****
         Dim count As Double
         Dim n As Double
         
         count = 1
         n = 1
         While count < 3
          SectionCoord(0) = 0 + (n - 1) * 40: SectionCoord(1) = 0
          SectionCoord(2) = ActiveSheet.Range("B3").Value + (n - 1) * 40: SectionCoord(3) = 0
          SectionCoord(4) = ActiveSheet.Range("B3").Value + (n - 1) * 40: SectionCoord(5) = ActiveSheet.Range("B4").Value
          SectionCoord(6) = 0: SectionCoord(7) = ActiveSheet.Range("B4").Value
          SectionCoord(8) = 0 + (n - 1) * 40: SectionCoord(9) = 0
  
         Topbar = ActiveSheet.Range("f8").Value
         BottomBar = ActiveSheet.Range("f9").Value
         Cover = ActiveSheet.Range("f10").Value
        ''****Draw rectangle****
             Set ActDoc = AutocadApp.ActiveDocument
             If ActDoc Is Nothing Then
           Set ActDoc = AutocadApp.Documents.Add
             End If
             Set Rectang = ActDoc.ModelSpace.AddLightWeightPolyline(SectionCoord)
              AutocadApp.ZoomExtents
            Set AutocadApp = Nothing
             Set ActDoc = Nothing
            Set Rectang = Nothing
       count = count + 1
       n = n + 1
        Wend
  End Sub