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

Liên hệ QC
V

Vương Đình Hiếu

Thành viên mới
Tham gia
5/7/17
Bài viết
12
Được thích
2
Giới tính
Nam
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.

Capture.PNG
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Vương Đình Hiếu đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộ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.
Mã: 
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
Mã: 
shp.Placement = xlMoveAndSize

thì thêm dòng

Mã: 
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
Mã: 
InsertPicture ThisWorkbook.Path & "\" & rng.Value & ".png", rng.Offset(0, 1)

thành

Mã: 
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.
Nhấp chuột vào đây để mở rộng...
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ì.
 
Lần chỉnh sửa cuối:
Upvote 0
batman1 đã viết:
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.
Mã: 
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
Mã: 
shp.Placement = xlMoveAndSize

thì thêm dòng

Mã: 
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
Mã: 
InsertPicture ThisWorkbook.Path & "\" & rng.Value & ".png", rng.Offset(0, 1)

thành

Mã: 
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ì.
Nhấp chuột vào đây để mở rộng...
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.
 

File đính kèm

  • Excel.xlsm
    1.4 MB · Đọc: 8
Upvote 0
Vương Đình Hiếu đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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 ->
Mã: 
=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
Mã: 
=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".
 
Upvote 0
batman1 đã viết:
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 ->
Mã: 
=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
Mã: 
=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".
Nhấp chuột vào đây để mở rộng...
Thank Pro, đã làm thành công. Cảm ơn Pro nhé.
Pro ngủ ngày cày đêm ghê thật
 
Upvote 0
Vương Đình Hiếu đã viết:
@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
Nhấp chuột vào đây để mở rộng...
1. Với code hiện thời thì không dùng được. Lý do? Vì trong code sub InsertPicture có dòng
Mã: 
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 " " 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
Mã: 
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ề.
 
Upvote 0
batman1 đã viết:
1. Với code hiện thời thì không dùng được. Lý do? Vì trong code sub InsertPicture có dòng
Mã: 
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 " " 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
Mã: 
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ề.
Nhấp chuột vào đây để mở rộng...
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 ạ
 
Upvote 0
Vương Đình Hiếu đã viết:
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 ạ
Nhấp chuột vào đây để mở rộ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.
 
Upvote 0
batman1 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Thank Pro, đã thành công.
 
Upvote 0
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
Capture.JPG

Mã: 
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
 

File đính kèm

  • Old_Chen-Hinh.xlsm
    37.5 KB · Đọc: 5
Lần chỉnh sửa cuối:
Upvote 0
Vương Đình Hiếu đã viết:
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
Nhấp chuột vào đây để mở rộng...
Nếu tôi hiểu ý thì hoặc nhập vào ô nào đó hoặc khai báo hằng số url
Mã: 
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ì

Mã: 
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.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
Xin giúp đỡ lệnh làm Biên bản giao hàng
Trả lời
0
Đọc
1
hongthuy1992
H
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
5
Đọc
79
yaaasoo01
Y
C
  • Question
VBA copy 2 vùng dữ liệu từ 1 workbook này sang 2 vùng của workbook khác!
    • Phẫn nộ
Trả lời
10
Đọc
121
cuongbv2103
C
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
14
Đọc
298
hiv174
H
Tình nghĩa giang hồ
Hỗ trợ dữ liệu xen kẽ căn bằng theo quy luật.
Trả lời
7
Đọc
119
Phan Thế Hiệp
Phan Thế Hiệp
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom