Sub Xuan()
'thu tuc xoa name rac
Dim Namerac As Name
For Each Namerac In ThisWorkbook.Names
If Namerac.Visible = False Then
Namerac.Delete
End If
Next
End Sub
Cái này là xóa các name bị ẩn đâu phải là name rác ?
Thầy có thể viết cụ thể câu lệnh đó giúp
File này chắc không phải do name rác mà là các shapes của phần mềm.
Các Bạn có thể giúp mình sửa code xóa hinh chỉ trong 1 sheet có được kg, vì trong File của mình còn rất nhiều hình khác, mình kg muốn nó bị xóa! Cảm ơn các bạn!
Code này chỉ xóa các hình trong sheet hiên hành
Sub xoa_shape()
Dim hinh As Shape
For Each hinh In ActiveSheet.Shapes
hinh.Visible = True
hinh.Delete
Next
End Sub
Hi anh, hôm nay đọc bài này em thấy có vấn đề muốn giải quyết
Sub xoa_shape()
Dim aShp, tmp As String, hinh As Shape
aShp = Array("Picture16", "AutoShape 100", "Line 1", "Button 19")
tmp = vbBack & Join(aShp, vbBack) & vbBack
For Each hinh In ActiveSheet.Shapes
If InStr(tmp, hinh.Name) = 0 Then
hinh.Visible = True
hinh.Delete
End If
Next
End SubFunction ShapeRange(ByVal wks As Worksheet, ByVal shp As Shape) As Range
On Error Resume Next
Set ShapeRange = wks.Range(shp.TopLeftCell, shp.BottomRightCell)
End FunctionSub DelShape()
Dim shpRng As Range, shp As Shape, wks As Worksheet
On Error Resume Next
Set wks = ActiveSheet
For Each shp In wks.Shapes
Set shpRng = ShapeRange(wks, shp)
If Intersect(shpRng, Range("C2:C1000")) Is Nothing Then
shp.Visible = True
shp.Delete
End If
Next
End SubThầy nói rõ thêm cách sử dụng hàm và code trên ạ!
Ô! cách này hay quá, nhưng sao mình thấy fải chạy code cho từng Sheet một, File của mình quá nhiều Sheet! Làm sao để nó chạy 1 lần cho 1 File kg nhỉ? mình cù lần cái vụ này! Bạn giúp mình nha! Xin cảm ơn rất nhiều!
Thì thử như vầy xem
Sub xoa_shape()
Dim aShp, tmp As String, hinh As Shape
Dim ws As Worksheet
aShp = Array("Picture16", "AutoShape 100", "Line 1", "Button 19")
tmp = vbBack & Join(aShp, vbBack) & vbBack
For Each ws In Worksheets
For Each hinh In ws.Shapes
If InStr(tmp, hinh.Name) = 0 Then
hinh.Visible = True
hinh.Delete
End If
Next
Next
End SubEm mới phát hiện 1 điều thú vị: Code trên & code của Thần Ndu (bài 14), nó xóa bén List của validation, và điểm đặc biệt nữa là nó không cho phục hồi List của validation!!!!!
Cái này dễ:
Shape là nói chung tất cả các object. Để phân biệt từng loại, ta phải viết code "chỉ" trực tiếp đến loại đó
Sub Test()
Dim wks As Worksheet
Set wks = ActiveSheet
wks.Rectangles.Delete ''<--- Xóa những shape thuộc loại Rectangle
wks.Pictures.Delete ''<--- Xóa những shape thuộc loại Picture
End SubSub Test2()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
MsgBox shp.Type, , shp.Name
Next shp
End SubMình được PHONG THẦN lúc nào không biết
Em đã làm theo những điều trên, và nó fát sinh 1 lỗi mới như sau:
Hì, em viết nhầm
Muốn liệt kê thì bạn cứ dùng vòng lập mà làm thôi (trong tầm tay bạn)... Còn chuyện GỌN gì gì đó tôi không hiểu (ý bạn muốn gọn nghĩa là thế nào?)
. Các bác có cách nào khác ngoài cut sang một file khác không. Thanks. Link file đây ah.
Vậy với trường hợp của mình thì xử lý thế nào đc các bác. Tình hình là e đã tìm hiểu và biết được nguyên nhân file này của em bị nặng là do số lượng Object quá lớn. Đến nỗi sử dụng cách nào cũng ko thể xóa đc. Cả dùng bằng lệnh, cả dùng bằng tay, cả Ctrl + G... cứ mỗi lần thao tác xong thì xoay mãi xoay mãi (ko biết đến lúc nào), dùng đoạn code trên vẫn treo
http://www.mediafire.com/?z70c4bll70gy5yp
Hình như nó có tới gần 4k các shapes thì phải.
Sub DelObjects()
Dim i As Long, wks As Worksheet
On Error Resume Next
Set wks = ActiveSheet
For i = 1 To 10000
wks.Shapes(1).Delete
Next
MsgBox "Còn " & wks.Shapes.Count & " objects"
End SubOK OK..Em làm đc rồi...) Thanks bác ndu96081631 nhiều nhé.
