Code báo lỗi Out of memory

[Tunguyen]

Các bác xem giúp em code này bị lỗi gì mà khi chạy bị báo lỗi Runtime error 7 : Out of memory :

Sub clearshape()

Dim i As Integer
Dim n As Integer

n = Worksheets.Count

For i = 1 To n
    
  Sheets(i).Activate
  ActiveSheet.Shapes.SelectAll
  Selection.Delete
Next i

End Sub

 

[chibi]

Tôi chạy không thấy lỗi gì.

 

[Mr Okebab]

Các bác xem giúp em code này bị lỗi gì mà khi chạy bị báo lỗi Runtime error 7 : Out of memory :

Sub clearshape()

Dim i As Integer
Dim n As Integer

n = Worksheets.Count

For i = 1 To n
    
  Sheets(i).Activate
  ActiveSheet.Shapes.SelectAll
  Selection.Delete
Next i

End Sub

Bạn thử nhé :

Sub clearshape()
    On Error Resume Next
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        Sh.Visible = xlSheetVisible
        Sh.Select
        Sh.DrawingObjects.Delete
    Next
End Sub

Thân!

 

[levanduyet]

To: Okebab,
Thực sự ra đoạn code trên đâu cần Select

Sub Clearshape()
    On Error Resume Next
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        Sh.Visible = xlSheetVisible
        Sh.DrawingObjects.Delete
    Next
End Sub

Select sẽ làm cho đoạn mã của bạn chậm đi.

Lê Văn Duyệt

 

[Tunguyen]

Cảm ơn bác Okebab, em chạy không bị lỗi gì, nhưng bác có thể giải thích giúp em tại sao code của em bị lỗi không, với cả tại sao nó khỗng xóa ngay shape trong từng sheet mà lại select tất cả shape trong các sheet rồi mới xóa nên hình như thế mới bị lỗi out of memory.
@chibi : bác chạy thử không lỗi vì số lượng sheet và số lượng shape mà bác thử ít, bác chạy thử với số lượng sheet khoảng 10 và số lượng shape khoảng 100 xem.