Code xóa hình ảnh có chọn lọc

[paulbi]

Nhờ cả nhà giúp em bài này ah:

Em có 1 folder chứa "hình ảnh" được đặt tên từ "Image 1 --> Image 99" trong đườn dẫn: "C:\picture"
Nhưng hiện nay em muốn xóa 21 hình ảnh theo tên như file đính kèm.
Nhờ cả nhà giúp em.
Đa tạ cả nhà.

 

[LamNA]

Nhờ cả nhà giúp em bài này ah:

Em có 1 folder chứa "hình ảnh" được đặt tên từ "Image 1 --> Image 99" trong đườn dẫn: "C:\picture"
Nhưng hiện nay em muốn xóa 21 hình ảnh theo tên như file đính kèm.
Nhờ cả nhà giúp em.
Đa tạ cả nhà.

Bạn thử xem đúng ý chưa nhé

Sub XoaAnh()
Dim Msg As String
Dim i As Integer
Dim D As Range
On Error Resume Next
Application.ScreenUpdating = False
Msg = MsgBox("Ban co muon xoa", vbYesNo)
Set Sh = Sheets("Xoa")
For i = 2 To 1000
For Each D In Worksheets("Xoa").Range("A" & i)
     Kill Range("A" & i)
     Next D
   Next i
   Range("A2:A1000").ClearContents
Application.ScreenUpdating = True
End Sub

 

[batman1]

MsgBox để làm gì khi Yes cũng xóa mà No cũng xóa?
For Each D để làm gì khi:

- D không dùng tới
- vòng lặp For chỉ chạy 1 lượt

???

Set Sh để làm gì khi sh không dùng tới?
--------------
@paulbi, bạn chỉ liệt kê tên, không có định dạng. Code lấy định dạng từ hằng EXT

Sub xoa_hinh()
Const folder = "C:\picture\"
Const ext = ".jpg"
Dim r As Long, data()
    With ThisWorkbook.Worksheets("Sheet1")
        data = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Value
    End With
    On Error Resume Next
    For r = 1 To UBound(data) - 1
        Kill folder & data(r, 1) & ext
    Next r
    On Error GoTo 0
End Sub

 

[LamNA]

MsgBox để làm gì khi Yes cũng xóa mà No cũng xóa?
For Each D để làm gì khi:

- D không dùng tới
- vòng lặp For chỉ chạy 1 lượt

???

Set Sh để làm gì khi sh không dùng tới?
--------------
@paulbi, bạn chỉ liệt kê tên, không có định dạng. Code lấy định dạng từ hằng EXT

Sub xoa_hinh()
Const folder = "C:\picture\"
Const ext = ".jpg"
Dim r As Long, data()
    With ThisWorkbook.Worksheets("Sheet1")
        data = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Value
    End With
    On Error Resume Next
    For r = 1 To UBound(data) - 1
        Kill folder & data(r, 1) & ext
    Next r
    On Error GoTo 0
End Sub

Em bốc ghép đó anh
Cám ơn anh nha

 

[paulbi]

MsgBox để làm gì khi Yes cũng xóa mà No cũng xóa?
For Each D để làm gì khi:

- D không dùng tới
- vòng lặp For chỉ chạy 1 lượt

???

Set Sh để làm gì khi sh không dùng tới?
--------------
@paulbi, bạn chỉ liệt kê tên, không có định dạng. Code lấy định dạng từ hằng EXT

Sub xoa_hinh()
Const folder = "C:\picture\"
Const ext = ".jpg"
Dim r As Long, data()
    With ThisWorkbook.Worksheets("Sheet1")
        data = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Value
    End With
    On Error Resume Next
    For r = 1 To UBound(data) - 1
        Kill folder & data(r, 1) & ext
    Next r
    On Error GoTo 0
End Sub

Cám ơn bạn nhiều nha,
File hình ảnh có định dạng là .jpeg, mình có chỉnh sửa lại Hầng EXT như bên dưới và chạy VBA thì không có thấy báo lỗi, mà lại cũng ko có xóa hình ảnh trong đường dẫn "C:\picture\". Bạn xem lại giúp mình nha,

Sub xoa_hinh()
Const folder = "C:\picture\"
Const ext = ".jpeg"
Dim r As Long, data()
With ThisWorkbook.Worksheets("Sheet1")
data = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Value
End With
On Error Resume Next
For r = 1 To UBound(data) - 1
Kill folder & data(r, 1) & ext
Next r
On Error GoTo 0
End Sub

 

[aroma07]

Bạn xài thử code này nhé

 

[paulbi]

Bạn xài thử code này nhé

Cám ơn bạn nhiều, mình chỉ cần thêm định dạng .jpeg là có thể xóa được hình ảnh.
Cám ơn cả nhà nhé.
I love you

 

[batman1]

Cám ơn bạn nhiều nha,
File hình ảnh có định dạng là .jpeg, mình có chỉnh sửa lại Hầng EXT như bên dưới và chạy VBA thì không có thấy báo lỗi, mà lại cũng ko có xóa hình ảnh trong đường dẫn "C:\picture\". Bạn xem lại giúp mình nha,

Với code tôi đưa thì thì tất cả các tập tin cần xóa phải cùng định dạng, tức cùng JPG, JPEG, BMP, GIF v...v. Và do cùng định dạng nên nhập định dạng đó vào EXT để sử dụng trong dòng

Kill folder & data(r, 1) & ext

Có thể bỏ EXT và trong dòng trên thay cho & EXT thi & ".jpg". Nhưng nhập vào EXT thì bạn có thể sử dụng ở nhiều nơi trong code (trong tương lai) và khi cần thay đổi định dạng thì chỉ sửa ở 1 chỗ duy nhất là hằng EXT thay cho sửa ở nhiều chỗ trong code.

Trong trường hợp có nhiều định dạng thì phải nhập vào cột A. Thay cho "Image 1", "Image 2", "Image 3" thì phải là "Image 1. jpg", "Image 2.jpeg", "Image 3.gif". Và lúc đó phải sửa code thành

Kill folder & data(r, 1)

Vì EXT không cần thiết nữa.

Còn nếu bạn muốn xóa các tập tin có tên "Image 1", "Image 2", "Image 3" bất luận chúng có định dạng gì thì phải sửa lại code.

Nếu bạn vẫn quả quyết là code có lỗi thì hãy đính kèm tập tin + thư mục có vài ảnh của bạn. Chả lý gì code chạy cho JPG lại không chạy cho JPEG.

 

[paulbi]

Với code tôi đưa thì thì tất cả các tập tin cần xóa phải cùng định dạng, tức cùng JPG, JPEG, BMP, GIF v...v. Và do cùng định dạng nên nhập định dạng đó vào EXT để sử dụng trong dòng

Kill folder & data(r, 1) & ext

Có thể bỏ EXT và trong dòng trên thay cho & EXT thi & ".jpg". Nhưng nhập vào EXT thì bạn có thể sử dụng ở nhiều nơi trong code (trong tương lai) và khi cần thay đổi định dạng thì chỉ sửa ở 1 chỗ duy nhất là hằng EXT thay cho sửa ở nhiều chỗ trong code.

Trong trường hợp có nhiều định dạng thì phải nhập vào cột A. Thay cho "Image 1", "Image 2", "Image 3" thì phải là "Image 1. jpg", "Image 2.jpeg", "Image 3.gif". Và lúc đó phải sửa code thành

Kill folder & data(r, 1)

Vì EXT không cần thiết nữa.

Còn nếu bạn muốn xóa các tập tin có tên "Image 1", "Image 2", "Image 3" bất luận chúng có định dạng gì thì phải sửa lại code.

Nếu bạn vẫn quả quyết là code có lỗi thì hãy đính kèm tập tin + thư mục có vài ảnh của bạn. Chả lý gì code chạy cho JPG lại không chạy cho JPEG.

Cám ơn bạn nhiều, mình đã tìm ra hướng giải pháp. tks bạn nhé, học hỏi rất nhiều từ bạn