[Hlep] Xóa ảnh theo tên và kích thước

[Luong24]

Em cần xóa ảnh trong file excel với 2 điều kiện là 1 cùng tên, 2 cùng kích thước thì sẽ xóa.
Ví dụ: Ảnh tên A và có kích thước Width = 0.01, Height = 0.01
Mong các bác giúp đỡ.
Em cảm ơn ạ!

 

[HUONGHCKT]

Em cần xóa ảnh trong file excel với 2 điều kiện là 1 cùng tên, 2 cùng kích thước thì sẽ xóa.
Ví dụ: Ảnh tên A và có kích thước Width = 0.01, Height = 0.01
Mong các bác giúp đỡ.
Em cảm ơn ạ!

Khuyên bạn Hỏi bài thì Bạn NÊN có file giả định đính kèm thì mới biết thế nào chứ, Không ai có thời gian để giúp bạn lập file giả định và code và bởi họ không biết ý bạn cụ thể là thế nào, code rồi lại phải sửa đi sửa lại.

 

[Luong24]

Khuyên bạn Hỏi bài thì Bạn NÊN có file giả định đính kèm thì mới biết thế nào chứ, Không ai có thời gian để giúp bạn lập file giả định và code và bởi họ không biết ý bạn cụ thể là thế nào, code rồi lại phải sửa đi sửa lại.

Dạ vâng, e gửi file lên đây ạ
Bổ sung thêm ý là các ảnh cần xóa đều có kích thước 0.01*0.01 nhưng trong file có các ảnh khác cần giữ lại, nên không thể chọn hết các ảnh và bấm xóa được, và hơn nữa là số lượng ảnh quá nhiều, bấm xóa hết thì lại rất lâu, nên là xóa theo tên trùng và kích thước thì sẽ bớt đơ và nhanh hơn ạ
việc kiểm tra cả tên và kích thước để tránh trường hợp có ảnh khác cũng trùng tên mà lại bị xóa nhầm ạ

 

[HUONGHCKT]

Dạ vâng, e gửi file lên đây ạ
Bổ sung thêm ý là các ảnh cần xóa đều có kích thước 0.01*0.01 nhưng trong file có các ảnh khác cần giữ lại, nên không thể chọn hết các ảnh và bấm xóa được, và hơn nữa là số lượng ảnh quá nhiều, bấm xóa hết thì lại rất lâu, nên là xóa theo tên trùng và kích thước thì sẽ bớt đơ và nhanh hơn ạ
việc kiểm tra cả tên và kích thước để tránh trường hợp có ảnh khác cũng trùng tên mà lại bị xóa nhầm ạ

Bạn tham khảo code sau:

Option Explicit
Dim Shp As Shape
Sub LietKeAnh()
Dim t&
Dim KQ(1 To 100000, 1 To 4)
With Sheets("Sheet1")

For Each Shp In .Shapes
    t = t + 1
'    .Range("A" & t) = t
'    .Range("B" & t) = Shp.Name
'    .Range("C" & t) = Shp.Width
'    .Range("D" & t) = Shp.Height
KQ(t, 1) = t
   KQ(t, 2) = Shp.Name
   KQ(t, 3) = Shp.Width
   KQ(t, 4) = Shp.Height
Next
.Range("A1").Resize(100000, 4).ClearContents
.Range("A1").Resize(t, 4) = KQ
End With
End Sub

Sub XoaAnh()

With Sheets("Sheet1")

For Each Shp In .Shapes
If Shp.Width = 0.75 And Shp.Height = 0.75 Then Shp.Delete

Next
End With
End Sub

Bạn chạy sub LietKeAnh() để xem trong Sheet1 của bạn có bao nhiêu ảnh và kích thước cụ thể từng ảnh thế nào. Sau đó lựa chọn để chạy Sub XoaAnh()
Trong Sub XoaAnh() tôi đang để là Xóa hết tất cả các shape có kích thước là Shp.Width = 0.75 And Shp.Height = 0.75 (vì trong Sheet1 này có 4256 shape thì có 3634 Shape A và 621 Shape B có kích thước như vậy , chỉ duy nhất có 1 Shape A có kích thước khác)