Help! Lọc nhanh những ô trống Object Hình ảnh

[Vương Đình Hiếu]

Các Pro giúp em với.
Hiện em có 1 file gồm mã ở Cột A và xuất hiện hình ở Cột B. Tuy nhiên vì dữ liệu mình nhiều nên khi Insert ảnh hàng loạt thì có những mã không có hình do sai định dạng hoặc mã chưa lưu hình. Vậy có cách nào đánh dấu ô không có hình hoặc lọc ra được hàng loạt những mã không có hình không ạ. Vì mỗi lần xuất dữ liệu báo cáo là khoảng hơn 4000 mã đi dò rất lâu mà đôi khi bị sót.

Em có mày mò được Code VBA chèn hình ảnh của bài viết Chèn Hình Hàng Loạt trên diễn đàn rất hay nhưng mình đang vướng chổ này. Vì mỗi lần xuất file cho từng người thì phải đi dò lại.
Vì File nặng em xin gửi Link tải ạ: https://drive.google.com/file/d/1WzDlxpWh9bk2YkMzG0cjJ3MGX7syG6f8/view?usp=sharing


À, nhân tiện nếu được cho em hỏi thêm, em muốn tạo ở Sheet 2 thêm là dò hình ảnh theo mã hàng loạt để khi đã đưa file hoàn chỉnh cho khách thì khách tự dò lại, không phải qua mình add hình nữa.

 

[batman1]

Các Pro giúp em với.
Hiện em có 1 file gồm mã ở Cột A và xuất hiện hình ở Cột B. Tuy nhiên vì dữ liệu mình nhiều nên khi Insert ảnh hàng loạt thì có những mã không có hình do sai định dạng hoặc mã chưa lưu hình. Vậy có cách nào đánh dấu ô không có hình hoặc lọc ra được hàng loạt những mã không có hình không ạ.

Khi không có ảnh thì ô sẽ trống. Vậy thì "ô trống" là cách đánh dấu tốt quá rồi còn gì.

Nếu cứ muốn đánh dấu thì có thể sửa SUB thành FUNCTION.

Function InsertPicture(ByVal PicFilename As String, Optional Target As Range = Nothing, _
                Optional original As Boolean = False, Optional center As Boolean = False, _
                Optional LinkToFile As Boolean = False) As Boolean

Và sau dòng

shp.Placement = xlMoveAndSize

thì thêm dòng

InsertPicture = True

Giả sử nếu không chèn ảnh thành công thì đánh dấu x ở cột C thì trong module Sheet1 sửa

InsertPicture ThisWorkbook.Path & "\" & rng.Value & ".png", rng.Offset(0, 1)

thành

If Not InsertPicture(ThisWorkbook.Path & "\" & rng.Value & ".png", rng.Offset(0, 1)) Then rng.Offset(0, 2).Value = "x"

Còn về

À, nhân tiện nếu được cho em hỏi thêm, em muốn tạo ở Sheet 2 thêm là dò hình ảnh theo mã hàng loạt để khi đã đưa file hoàn chỉnh cho khách thì khách tự dò lại, không phải qua mình add hình nữa.

Trong tập tin chỉ có Sheet1, không có Sheet2. Ngoài ra muốn hỏi gì thì phải mô tả cụ thể, nếu cần thì phải cho ví dụ. Tôi không lanh lợi như những người khác nên không hiểu bạn nói gì.

 

[Vương Đình Hiếu]

Khi không có ảnh thì ô sẽ trống. Vậy thì "ô trống" là cách đánh dấu tốt quá rồi còn gì.

Nếu cứ muốn đánh dấu thì có thể sửa SUB thành FUNCTION.

Function InsertPicture(ByVal PicFilename As String, Optional Target As Range = Nothing, _
                Optional original As Boolean = False, Optional center As Boolean = False, _
                Optional LinkToFile As Boolean = False) As Boolean

Và sau dòng

shp.Placement = xlMoveAndSize

thì thêm dòng

InsertPicture = True

Giả sử nếu không chèn ảnh thành công thì đánh dấu x ở cột C thì trong module Sheet1 sửa

InsertPicture ThisWorkbook.Path & "\" & rng.Value & ".png", rng.Offset(0, 1)

thành

If Not InsertPicture(ThisWorkbook.Path & "\" & rng.Value & ".png", rng.Offset(0, 1)) Then rng.Offset(0, 2).Value = "x"

Còn về

Trong tập tin chỉ có Sheet1, không có Sheet2. Ngoài ra muốn hỏi gì thì phải mô tả cụ thể, nếu cần thì phải cho ví dụ. Tôi không lanh lợi như những người khác nên không hiểu bạn nói gì.

Pro đã xuất hiện. Em hâm mộ anh từ bài viết hướng dẫn chèn hình tự động luôn đó anh.
Em sơ xuất quá, yêu cầu mà không gửi đúng File. Em gửi lại ạ
Sheet "Dò Tìm"
- Cột A: Mã cần dò
- Cột B: Hình ảnh của mã đó dựa trên dữ liệu Sheet 1

Pro @batman1 có thể hướng dẫn giúp làm cách nào khi chèn hình thì ấn vô hình là tên mã chứ không phải tên cột cố định không ạ. Em nghĩ như vậy mới dò được. Không biết có đúng không nữa.

 

[batman1]

Em sơ xuất quá, yêu cầu mà không gửi đúng File. Em gửi lại ạ
Sheet "Dò Tìm"
- Cột A: Mã cần dò
- Cột B: Hình ảnh của mã đó dựa trên dữ liệu Sheet 1

Tùy tình hình mà lựa cách làm thôi. Trong sheet "Dò Tìm" số lượng mã nhập trong cột A là tùy ý? Có thể 2 hoặc 7 mà cũng có thể hàng nghìn?

Pro @batman1 có thể hướng dẫn giúp làm cách nào khi chèn hình thì ấn vô hình là tên mã chứ không phải tên cột cố định không ạ. Em nghĩ như vậy mới dò được. Không biết có đúng không nữa.

Tôi không hiểu bạn nói gì.

Thôi tôi đi ngủ đây, hôm nay thức tới sáng rồi.

 

[batman1]

Giả sử nhập mã vào A1 và muốn hiện ảnh tìm thấy ở B2.

1. Chọn sheet "Dò Tìm" -> nhập vào A2 một mã tùy ý.

2. thêm name: Formulas -> Name Manager -> New -> name -> anh_sp, refers to ->

=INDEX(Sheet1!$B$2:$B$100;MATCH($A$2;Sheet1!$A$2:$A$100;0))

3. sang Sheet1 -> chọn C2 -> nhấn phím mũi tên sang trái <- để chọn B2 -> Ctrl + C -> sang "Dò Tìm" -> chọn B2 -> thẻ Home -> Paste -> trong phần "Other Paste Options" đưa chuột vào biểu tượng nào mà có gợi ý "Linked Picture" thì nhấn chuột chọn nó -> nhìn lên thanh tiêu đề thấy

=Sheet1!$B$2

-> sửa thành =anh_sp

Nếu muốn nhập rất nhiều mã, vd. hàng trăm mã ở cột A, và hàng trăm ảnh hiển thị ở cột B thì có lẽ chỉ dùng code copy ảnh từ Sheet1 và dán vào "Dò Tìm".

 

[Vương Đình Hiếu]

Giả sử nhập mã vào A1 và muốn hiện ảnh tìm thấy ở B2.

1. Chọn sheet "Dò Tìm" -> nhập vào A2 một mã tùy ý.

2. thêm name: Formulas -> Name Manager -> New -> name -> anh_sp, refers to ->

=INDEX(Sheet1!$B$2:$B$100;MATCH($A$2;Sheet1!$A$2:$A$100;0))

3. sang Sheet1 -> chọn C2 -> nhấn phím mũi tên sang trái <- để chọn B2 -> Ctrl + C -> sang "Dò Tìm" -> chọn B2 -> thẻ Home -> Paste -> trong phần "Other Paste Options" đưa chuột vào biểu tượng nào mà có gợi ý "Linked Picture" thì nhấn chuột chọn nó -> nhìn lên thanh tiêu đề thấy

=Sheet1!$B$2

-> sửa thành =anh_sp

Nếu muốn nhập rất nhiều mã, vd. hàng trăm mã ở cột A, và hàng trăm ảnh hiển thị ở cột B thì có lẽ chỉ dùng code copy ảnh từ Sheet1 và dán vào "Dò Tìm".

Thank Pro, đã làm thành công. Cảm ơn Pro nhé.
Pro ngủ ngày cày đêm ghê thật

 

[Maika8008]

Thank Pro, đã làm thành công. Cảm ơn Pro nhé.
Pro ngủ ngày cày đêm ghê thật

Ông ấy ở khác múi giờ với anh em mình bạn à.

 

[batman1]

Ông ấy ở khác múi giờ với anh em mình bạn à.

Chênh với VN 5 tiếng. Lúc tôi đi ngủ thì ở VN 8:42, còn ở đây là 3:42. Thế cũng là ngủ ngày rồi.

 

[Vương Đình Hiếu]

@batman1
Cho mình hỏi thêm chút Pro ơi. Cũng đoạn Code như trên mình muốn Insert ảnh từ Link Online thì làm thế nào nhỉ
Ví dụ hình này: https://toquoc.mediacdn.vn/2020/4/26/da-nang-15878865291212013802504.jpg

 

[batman1]

@batman1
Cho mình hỏi thêm chút Pro ơi. Cũng đoạn Code như trên mình muốn Insert ảnh từ Link Online thì làm thế nào nhỉ
Ví dụ hình này: https://toquoc.mediacdn.vn/2020/4/26/da-nang-15878865291212013802504.jpg

1. Với code hiện thời thì không dùng được. Lý do? Vì trong code sub InsertPicture có dòng

If fso.FileExists(PicFilename) Then

Nếu PicFilename là đường dẫn tới tập tin trên mạng thì fso.FileExists(PicFilename) trả về False và code chèn ảnh không được thực hiện.

Nếu muốn chèn ảnh từ internet thì:
- bỏ dòng tôi trích ở trên
- bỏ dòng End If ngay trước dòng Set fso = Nothing.

Tức bây giờ code không kiểm tra sự tồn tại của tập tin ảnh nữa.

2. Giả sử đường dẫn tới ảnh là https://toquoc.mediacdn.vn/2020/4/26/da-nang-15878865291212013802504.jpg

Vậy trong cột A bạn sẽ nhập tên ảnh như thế nào? Giả sử bạn chỉ nhập tên ảnh ở cột A là "da-nang-15878865291212013802504". Hàm ý là code sẽ lấy tên thư mục "

https://toquoc.mediacdn.vn/2020/4/26/

" nối với tên ở cột A, và với định dạng ".JPG" để có đường dẫn đầy đủ.

Với giả thiết như trên thì:
a. Sửa trong sub InsertPicture như trên tôi đã hướng dẫn.

b. Sửa trong module Sheet1 thành

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
    If Intersect(Target, [A2:A10000]) Is Nothing Then Exit Sub
    For Each rng In Target
        If Not InsertPicture("https://toquoc.mediacdn.vn/2020/4/26/" & rng.Value & ".jpg", rng.Offset(0, 1)) Then rng.Offset(0, 1).Value = "x"
    Next rng
End Sub

Sau khi nhập tên vào ô ở cột A thì phải đợi chút để ảnh được tải về.

 

[Vương Đình Hiếu]

1. Với code hiện thời thì không dùng được. Lý do? Vì trong code sub InsertPicture có dòng

If fso.FileExists(PicFilename) Then

Nếu PicFilename là đường dẫn tới tập tin trên mạng thì fso.FileExists(PicFilename) trả về False và code chèn ảnh không được thực hiện.

Nếu muốn chèn ảnh từ internet thì:
- bỏ dòng tôi trích ở trên
- bỏ dòng End If ngay trước dòng Set fso = Nothing.

Tức bây giờ code không kiểm tra sự tồn tại của tập tin ảnh nữa.

2. Giả sử đường dẫn tới ảnh là https://toquoc.mediacdn.vn/2020/4/26/da-nang-15878865291212013802504.jpg

Vậy trong cột A bạn sẽ nhập tên ảnh như thế nào? Giả sử bạn chỉ nhập tên ảnh ở cột A là "da-nang-15878865291212013802504". Hàm ý là code sẽ lấy tên thư mục "

https://toquoc.mediacdn.vn/2020/4/26/

" nối với tên ở cột A, và với định dạng ".JPG" để có đường dẫn đầy đủ.

Với giả thiết như trên thì:
a. Sửa trong sub InsertPicture như trên tôi đã hướng dẫn.

b. Sửa trong module Sheet1 thành

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
    If Intersect(Target, [A2:A10000]) Is Nothing Then Exit Sub
    For Each rng In Target
        If Not InsertPicture("https://toquoc.mediacdn.vn/2020/4/26/" & rng.Value & ".jpg", rng.Offset(0, 1)) Then rng.Offset(0, 1).Value = "x"
    Next rng
End Sub

Sau khi nhập tên vào ô ở cột A thì phải đợi chút để ảnh được tải về.

Hi Pro. Đã chèn thành công. Tuy nhiên khi mã Link sai là báo lỗi. Có cách nào vẫn như cũ là không có sẽ bấm dấu chéo như ban đầu không ạ

 

[batman1]

Hi Pro. Đã chèn thành công. Tuy nhiên khi mã Link sai là báo lỗi. Có cách nào vẫn như cũ là không có sẽ bấm dấu chéo như ban đầu không ạ

Trong hàm InsertPicture xóa dòng On Error GoTo 0. Tức dòng On Error Resume Next có hiệu lực cho tới End Sub. Thực ra code chỉ là chèn ảnh, có lỗi thì bỏ qua thôi. Nếu kiểm tra sự tồn tại của ảnh mà ảnh không tồn tại thì không thực hiện code và hàm InsertPicture trả về FALSE. Còn nếu bỏ kiểm tra thì khi ảnh không tồn tại thì hàm InsertPicture cũng lại trả về FALSE. Kết quả như nhau.

 

[Vương Đình Hiếu]

Trong hàm InsertPicture xóa dòng On Error GoTo 0. Tức dòng On Error Resume Next có hiệu lực cho tới End Sub. Thực ra code chỉ là chèn ảnh, có lỗi thì bỏ qua thôi. Nếu kiểm tra sự tồn tại của ảnh mà ảnh không tồn tại thì không thực hiện code và hàm InsertPicture trả về FALSE. Còn nếu bỏ kiểm tra thì khi ảnh không tồn tại thì hàm InsertPicture cũng lại trả về FALSE. Kết quả như nhau.

Thank Pro, đã thành công.

 

[Vương Đình Hiếu]

Pro @batman1 giúp em với
Hiện tại mình đã dùng cách thức này để chèn ảnh hàng loạt. Khi bấm chèn hình sẽ hiện chọn ô chứa Link và chọn ô ra hình ảnh. Tuy nhiên có cách nào ẩn https://chienhuy.com/wp-content/uploads/2021/09/ phía trước không ạ, chỉ dùng mã ngắn giống ô A

Option Explicit

Sub ChenAnh()
Dim rS As Range
Dim rD As Range
On Error Resume Next


Set rS = Application.InputBox("Vung chua link anh", Type:=8)
If Err.Number <> 0 Then Exit Sub
Set rD = Application.InputBox("Vung chua anh", Type:=8)
If Err.Number <> 0 Then Exit Sub
InsertPicture rS, rD, True

End Sub

Private Function AutoPicture(rPath As Range)
Dim ca  As Range
Application.Volatile
Set ca = Application.Caller

AutoPicture = InsertPicture(rPath, Application.Caller, False)
End Function


Private Sub ClearPicture(rrg As Range, isSubCall As Boolean)
Dim Ws As Worksheet
Dim pPics As Pictures
Dim pPic As Picture

On Error Resume Next
Set Ws = rrg.Worksheet


If isSubCall = True Then
    'xoa anh nam tren cell
    Set pPics = Ws.Pictures
    For Each pPic In pPics
        If Not (Application.Intersect(rrg, pPic.TopLeftCell) Is Nothing) Then
            If Not (Application.Intersect(rrg, pPic.BottomRightCell) Is Nothing) Then
                pPic.Delete
        
            End If
        End If
    Next
Else
    Dim rIndex As Range
    For Each rIndex In rrg
        Set pPic = Ws.Shapes(rIndex)
        pPic.Delete
    Next
    

End If

End Sub

 Private Function InsertPicture(rS As Range, rD As Range, Optional isSubCall As Boolean = True)

Dim lRows As Long
Dim lCols As Long
Dim lRow As Long
Dim lCol As Long
Dim rrg As Range
Dim Pic As Shape
Dim Ws As Worksheet
Set Ws = rD.Worksheet



lRows = rS.Rows.Count
lCols = rD.Columns.Count

If rS.Rows.Count <> rD.Rows.Count Or rS.Columns.Count <> rD.Columns.Count Then InsertPicture = CVErr(xlErrNA): Exit Function

On Error Resume Next
If isSubCall = True Then
    If MsgBox("Xoa anh cu", vbYesNo) = vbYes Then
        ClearPicture rD, True 'xoa cac anh cu
    End If

Else
    ClearPicture rD, False 'xoa anh voi tu cach ham
End If

Dim vKQ() As Variant
ReDim vKQ(1 To lRows, 1 To lCols) As Variant

For lRow = 1 To lRows
    For lCol = 1 To lCols
        Set rrg = rD(lRow, lCol)
        Err.Clear
        
       Set Pic = Ws.Shapes.AddPicture(rS(lRow, lCol), msoFalse, msoTrue, 1, 1, -1, -1)
      
      
        If Err.Number <> 0 Then
            vKQ(lRow, lCol) = CVErr(xlErrNA)
        Else
            vKQ(lRow, lCol) = Pic.Name
            Pic.Placement = xlMoveAndSize
            ReSizeShape Pic, rrg
        End If
        
        
    Next
Next lRow

InsertPicture = vKQ

End Function

Private Sub ReSizeShape(a As Shape, rrg As Range)

Dim shr As Single
Dim swr As Single
Dim sha As Single
Dim swa As Single
Dim sTyLe As Single

a.LockAspectRatio = msoFalse
a.ScaleHeight 1, msoTrue, msoScaleFromMiddle
a.ScaleWidth 1, msoTrue, msoScaleFromMiddle

'shr = rrg.Height
'swr = rrg.Width

shr = rrg.MergeArea.Height
swr = rrg.MergeArea.Width



sha = a.Height
swa = a.Width
sTyLe = 10
If (shr / swr) >= (sha / swa) Then
    'a.Width = rrg.Width * (100 - sTyLe) / 100
    a.Width = swr * (100 - sTyLe) / 100
    
    a.Height = (a.Width * sha) / swa
  
Else
    'a.Height = rrg.Height * (100 - sTyLe) / 100
    a.Height = shr * (100 - sTyLe) / 100
    a.Width = (a.Height * swa) / sha
  
    
End If
'a.Left = rrg.Left + (rrg.Width - a.Width) / 2
'a.Top = rrg.Top + (rrg.Height - a.Height) / 2

a.Left = rrg.Left + (swr - a.Width) / 2
a.Top = rrg.Top + (shr - a.Height) / 2

a.LockAspectRatio = msoTrue
End Sub

 

[batman1]

Pro @batman1 giúp em với
Hiện tại mình đã dùng cách thức này để chèn ảnh hàng loạt. Khi bấm chèn hình sẽ hiện chọn ô chứa Link và chọn ô ra hình ảnh. Tuy nhiên có cách nào ẩn https://chienhuy.com/wp-content/uploads/2021/09/ phía trước không ạ, chỉ dùng mã ngắn giống ô A

Nếu tôi hiểu ý thì hoặc nhập

https://chienhuy.com/wp-content/uploads/2021/09/

vào ô nào đó hoặc khai báo hằng số url

Option Explicit

Private Const url = "https://chienhuy.com/wp-content/uploads/2021/09/"

Sau đó cứ chỗ nào cần tạo đường dẫn đầy đủ tới tập tin thì

path = url & "<tên ảnh + định dạng, vd. "ngay mai em di.jpg", hoặc cell_.Value với cell_ là ô chứa tên ảnh + định dạng>

Nếu chưa hiểu hoặc muốn hỏi thêm thì tạo chủ đề mới. Vấn đề mới này không liên quan tới code của tôi. Code mới chỉ có điểm chung với code của tôi ở cái tên InsertPicture. Còn nội dung code hoàn toàn khác nhau. Hoặc chủ đề mới hỏi mọi người, hoặc bạn hỏi người viết code kia cho bạn. Tôi chỉ giúp bạn đến thế thôi.