Code xóa ảnh

[trthuat]

Chủ đề này ai đó đã post lên thấy hay. Xin phép tác giả cho tôi hỏi các pro trên GPE muốn tạo code xóa các ảnh (được tạo ra bằng cách dùng nút Print Screen chụp màn hình )
Tôi đã thử thu Macro nhưng không áp dụng được cho các hình mới. Cám ơn các anh chị.
Files đính kèm

 

[ndu96081631]

Chủ đề này ai đó đã post lên thấy hay. Xin phép tác giả cho tôi hỏi các pro trên GPE muốn tạo code xóa các ảnh (được tạo ra bằng cách dùng nút Print Screen chụp màn hình )
Tôi đã thử thu Macro nhưng không áp dụng được cho các hình mới. Cám ơn các anh chị.
Files đính kèm

Mổi 1 object đều có cái "TÊN"
Bạn giữ phím Ctrl rồi click vào object, nhìn lên hộp name box sẽ thấy tên của nó
Vậy muốn xóa "TÊN" nào thì điền tên nó vào code thôi, ví dụ:

Sub XOA()
  ActiveSheet.Shapes("Oval 6").Delete
End Sub

Đấy là xóa cái Object có tên Oval 6

 

[trthuat]

Mổi 1 object đều có cái "TÊN"
Bạn giữ phím Ctrl rồi click vào object, nhìn lên hộp name box sẽ thấy tên của nó
Vậy muốn xóa "TÊN" nào thì điền tên nó vào code thôi, ví dụ:

Sub XOA()
  ActiveSheet.Shapes("Oval 6").Delete
End Sub

Đấy là xóa cái Object có tên Oval 6

Cám ơn ndu quan tâm. Không phải cái Oval đâu bạn ơi mà là cái Picture (vì tôi không thể gởi files kèm hình được chèn, do nặng quá )
Để tôi diển đạt lại cho rỏ nhé:
Đầu tiên tôi chụp 2 lần màn hình bất kỳ bằng nút Print Screen sau đó paste vào 2 ô khác nhau trong sheet 2, rồi bấm nút chèn, nó chèn vào 2 khung định trước.
Sau đó tôi thử ghi Macro xóa.
Đây là macro tôi ghi được:
Sub XOA()
ActiveSheet.Shapes("Picture 11").Select
Selection.Delete
ActiveSheet.Shapes("Picture 12").Select
Selection.Delete
End Sub

Cái không hiểu là sau mổi lần chèn hình tiếp theo nó lại đặt tên mới “Picture 13”, “Picture 14”, “Picture 15”,….. 16…
Dó đó cái macro xóa tôi ghi nó không tự động hiểu và tìm tên mới để xóa cho nên nó báo lổi. Bạn xem lại và giúp tôi nhé. Cám ơn bạn nhiều.
Xem files đính kèm

 

[ndu96081631]

Cái không hiểu là sau mổi lần chèn hình tiếp theo nó lại đặt tên mới “Picture 13”, “Picture 14”, “Picture 15”,….. 16…
Dó đó cái macro xóa tôi ghi nó không tự động hiểu và tìm tên mới để xóa cho nên nó báo lổi. Bạn xem lại và giúp tôi nhé. Cám ơn bạn nhiều.
Xem files đính kèm

Tức ý bạn muốn Object nào có tên là Pictuer* thì xóa, đúng không?
Vậy thì thế này:

Sub DelPic()
  Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    If Shp.Name Like "Picture*" Then Shp.Delete
  Next Shp
End Sub

Hoặc cách viết khác:

Sub DelPic()
  Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    If InStr(Shp.Name, "Picture") Then Shp.Delete
  Next Shp
End Sub

 

[trthuat]

Cám ơn bạn nhiều nhé_ ndu. Cái code của bạn nó "tự hiểu" và xử lý tốt đúng ý mình rồi. Đúng là chuyên gia GPE ndu luôn giải đáp thỏa đáng gần như mọi thắc mắc của thành viên khác.

 

[Hai Lúa Miền Tây]

Tức ý bạn muốn Object nào có tên là Pictuer* thì xóa, đúng không?
Vậy thì thế này:

Sub DelPic()
  Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    If Shp.Name Like "Picture*" Then Shp.Delete
  Next Shp
End Sub

Hoặc cách viết khác:

Sub DelPic()
  Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    If InStr(Shp.Name, "Picture") Then Shp.Delete
  Next Shp
End Sub

Theo em nghĩ không cần dùng dòng lặp đâu Thầy à, chọn hình và xóa nó thôi

Sub XoaHinh()
On Error Resume Next
    ActiveSheet.Pictures.Delete
End Sub