Oprettelse af flere objekter af visio type

Hej

Jeg har en stump kode som indsætter visio tegninger i et exceldokument. Det hele virker fint, når der kun skal indsættes 5-6 tegninger, men problemet kommer når der skal indsættes flere. JEg kan se i joblisten, at der oprettes en visio-instans for hvert gennemløb af koden.

Kan jeg i koden frigive den hukommelse der er blevet anvendt? Jeg ved, at det er muligt at gøre hvis man har brugt kommandoen CreateObject, men der er ikke umiddelbart muligt at skifte til den metode.

Torben

KODE:
    Do While ActiveCell <> ""
        tempnavn2 = Mid(ActiveCell, 22)
        Set NewSheet = Worksheets.Add
        NewSheet.Move After:=Worksheets(TempNavn1)
        NewSheet.Name = tempnavn2
        TempNavn1 = tempnavn2
        Range("A1").Select
        ActiveSheet.OLEObjects.Add(Filename:=tempsti & "DC-Horsens Flowskema " & tempnavn2 & ".vsd" _
                , Link:=False, DisplayAsIcon:=False).Select
        Selection.Verb Verb:=xlPrimary
        Range("A1").Select
        ActiveSheet.Shapes("Object 1").Select
        If Selection.ShapeRange.Height > 600 Then
            Rows("1:63").RowHeight = 12.75
            Rows("64:64").RowHeight = 17.25
            Columns("A:J").ColumnWidth = 8.43
            Columns("K:K").ColumnWidth = 9.71
            With ActiveSheet.PageSetup
                .LeftMargin = Application.CentimetersToPoints(0.6)
                .RightMargin = Application.CentimetersToPoints(0.5)
                .TopMargin = Application.CentimetersToPoints(1.1)
                .BottomMargin = Application.CentimetersToPoints(0.5)
                .Orientation = xlPortrait
            End With
            Selection.ShapeRange.LockAspectRatio = msoFalse
            Selection.ShapeRange.Height = 820
            Selection.ShapeRange.Width = 534
            Selection.ShapeRange.Line.Visible = msoFalse
            Range("A1").Select
        Else
            Rows("1:44").RowHeight = 12.75
            Rows("45:45").RowHeight = 19.5
            Columns("A:N").ColumnWidth = 8.43
            Columns("O:O").ColumnWidth = 14.86
            With ActiveSheet.PageSetup
                .LeftMargin = Application.CentimetersToPoints(1.1)
                .RightMargin = Application.CentimetersToPoints(0.5)
                .TopMargin = Application.CentimetersToPoints(0.6)
                .BottomMargin = Application.CentimetersToPoints(0.5)
                .Orientation = xlLandscape
            End With
            Selection.ShapeRange.LockAspectRatio = msoFalse
            Selection.ShapeRange.Height = 580
            Selection.ShapeRange.Width = 754
            Selection.ShapeRange.Line.Visible = msoFalse
            Range("A1").Select
        End If
        Sheets("Filer").Select
        ActiveCell.Offset(1, 0).Select
    Loop