Nhờ sửa giúp đoạn code xoá ảnh trong khu vực được chọn (1 người xem)

[Trojan]

Chào các bác. Tôi có sử dụng đoạn code như sau:

Sub XoaAnh()
Dim s As String
Dim pic As Picture
Dim rng As Range
Set ws = ActiveWorkbook.ActiveSheet
Set rng = ws.Range("A5:C25")
For Each pic In ActiveSheet.Pictures
With pic
s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
If Not Intersect(rng, ws.Range(s)) Is Nothing Then
pic.Delete
End If
Next
End Sub

Cái này nó chỉ xoá trong khu vực từ ô A5 đến C25. Vậy giờ tôi muốn xoá ảnh không khu vực cell bôi đen thì sao? Nhờ các bác sửa giúp với. Chân thành cảm ơn.

 

[vu_tuan_manh_linh]

Anh thử thay cái đoạn Range("A5:C25") bằng Selection

 

[ndu96081631]

Chào các bác. Tôi có sử dụng đoạn code như sau:

Sub XoaAnh()
Dim s As String
Dim pic As Picture
Dim rng As Range
Set ws = ActiveWorkbook.ActiveSheet
Set rng = ws.Range("A5:C25")
For Each pic In ActiveSheet.Pictures
With pic
s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
If Not Intersect(rng, ws.Range(s)) Is Nothing Then
pic.Delete
End If
Next
End Sub

Cái này nó chỉ xoá trong khu vực từ ô A5 đến C25. Vậy giờ tôi muốn xoá ảnh không khu vực cell bôi đen thì sao? Nhờ các bác sửa giúp với. Chân thành cảm ơn.

Để thuận tiện bạn nên xây dựng 1 hàm xác định vùng bao quanh picture như thế này:

Function PicRange(ByVal pic As Picture) As Range
  On Error Resume Next
  Set PicRange = pic.Parent.Range(pic.TopLeftCell, pic.BottomRightCell)
End Function

Tiếp theo viết code xóa ảnh trong vùng chọn:

Sub XoaAnh()
  Dim rng As Range, rngPic As Range, pic As Picture
  If TypeOf Selection Is Range Then
    Set rng = Selection
    For Each pic In ActiveSheet.Pictures
      Set rngPic = PicRange(pic)
      If Not Intersect(rngPic, rng) Is Nothing Then pic.Delete
    Next
  End If
End Sub

Đơn giản vậy thôi