Vấn đề của em là khi có 1 cột mã hàng, thì excel sẽ tự chèn ảnh có sẵn (trong thư mục cố định, tên file là tên của mã hàng) vào cột bên cạnh.
Trước đó em có xài cách của 1 bác khác là viết 1 hàm riêng cho file excel đó, hàm compic(đường dẫn hình). Là dạng chèn hình vào comment. Nhưng do lúc chạy rất hay bị văng ra nên không được tiện lắm.
Hôm qua em mò trên mạng được code VBA của 1 bác về chèn hình vào excel sau khi ta gõ mã của hình đó.
Thấy code của bác này chạy rất nhẹ nhàng và chèn trực tiếp (chứ không phải comment), nên em rất thích.
Nhưng chưa đủ áp dụng vào công việc của em, nhờ các bác cao thủ giúp em với ạ:
- File đính kèm đã có code chạy cho cột mã 1
- Nếu em có thêm cột mã 2 thì code sẽ viết như thế nào? (Nếu dạng hàm thì quá dễ, hàm ở đâu hình sẽ hiện ở đó)
- Cột mã nếu là công thức hoặc khi copy dán thì code không chạy (cả ngàn mã không thể gõ tay rồi enter được) -> lỗi type miss match
- Nếu trong 10 mã mà có 5 mã bị sai, bỏ trống -> 5 mã còn lại vẫn hiện hình, 5 mã kia không hiện (đằng này báo lỗi và ko hiện tất)
Nếu cột Mã dùng công thức thì khi công thức phải tính lại do tham chiếu thay đổi thì sự kiện Change không sảy ra nên code sẽ không được thực hiện. Và kết quả là ảnh không được đổi.
Code dưới đây cho phép dán hàng loạt Mã.
-------------
Trước hết về sub tổng quát InsertPicture. Bạn có thể lưu Module cùng với InsertPicture vào "thư viện" - một thư mực nào đó, để khi cần thì chỉ (trong VBE): File -> Import File -> duyệt tới tập tin BAS đã lưu -> chọn tập tin BAS để thêm vào tập tin Excel hiện hành -> dùng Sub InsertPicture trong tập tin hiện hành.
Bạn không nên dùng Pictures vì đôi khi gặp những lỗi khó hiểu.
InsertPicture có nhiều tùy chọn: có thể nhập ảnh vào 1 ô hoặc vùng nhiều ô mà không cần merge cells, nhập ảnh với kích thước thực, nhập ảnh center trong ô/vùng hoặc vừa khít, nhập ảnh nhưng khi mang sang máy khác thì phải mang ảnh theo hoặc nhập ảnh vĩnh viễn vào sheet để khi mang sang máy khác thì không phải mang ảnh đi theo.
Private Sub Worksheet_Change(ByVal Target As range)
Dim rng As range
If Intersect(Target, Union([A2:A10000], [D2:D10000])) Is Nothing Then Exit Sub
For Each rng In Target
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1)
Next rng
End Sub
Code trên cho phép bạn dán tên ảnh (copy từ đâu đó) hàng loạt vào cột A hoặc D kể từ dòng 2 trở đi.
Với code trên thì sau khi chèn ảnh có thể xóa ảnh trên đĩa và khi gửi cho đối tác không phải gửi ảnh theo. Nếu bạn không xóa ảnh trên đĩa và luôn gửi ảnh kèm tập tin cho đối tác thì nên chèn link thôi để tập tin nhẹ. Trong trường hợp này sửa thành
Nếu ảnh không là JPG thì sửa ".jpg" thích hợp.
Nếu ảnh ở thư mục con vd. Anh thì sửa ThisWorkbook.path & "\" thành ThisWorkbook.path & "\Anh\"
Code phục vụ 2 cột là A và D. Nếu có thêm cột thì thêm vào trong ngoặc của Union([A2:A10000], [D210000])
Cuối cùng là sub tổng quát InsertPicture: Mở tập tin -> Alt + F11 -> menu Insert -> Module -> dán code dưới vào Module vừa thêm.
Để có thể dùng sub tổng quát InsertPicture trong những tập tin tương lai thì: chọn Module (click tên Module) -> menu File -> Export File -> duyệt tới thư mục cần lưu -> lưu lại với tên nào đó.BAS
Code cho Module vừa thêm
Mã:
Sub 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)
' Target: vung nhap anh. Co the la nhieu cell
' Neu Target = Nothing thi Target = ActiveCell
' Neu original = True thi nhap anh kich thuoc thuc.
' Neu original = FALSE thi neu center = True thi anh se center trong vung Target,
' nguoc lai thi se vua khit vung Target
' LinkToFile = False thi khong can giu anh tren dia, nguoc lai bat buoc phai giu anh de moi lan mo thi co
Dim w As Double, h As Double, shp As Shape, fso As Object
If Target Is Nothing Then Set Target = ActiveCell
On Error Resume Next
Target.Parent.Shapes(Target.Address).Delete
On Error GoTo 0
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(PicFilename) Then
If LinkToFile Then
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoTrue, msoFalse, Target.left, Target.top, 0, 0)
Else
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
End If
If Not shp Is Nothing Then
With shp
If original Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
ElseIf center Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
w = Target.Width
h = w * .Height / .Width
If h > Target.Height Then
h = Target.Height
w = h * .Width / .Height
End If
.left = Target.left + (Target.Width - w) / 2
.top = Target.top + (Target.Height - h) / 2
.Width = w
.Height = h
Else
.Width = Target.Width
.Height = Target.Height
End If
shp.Name = Target.Address
shp.Placement = xlMoveAndSize
End With
End If
End If
Set fso = Nothing
End Sub
Nếu cột Mã dùng công thức thì khi công thức phải tính lại do tham chiếu thay đổi thì sự kiện Change không sảy ra nên code sẽ không được thực hiện. Và kết quả là ảnh không được đổi.
Code dưới đây cho phép dán hàng loạt Mã.
-------------
Trước hết về sub tổng quát InsertPicture. Bạn có thể lưu Module cùng với InsertPicture vào "thư viện" - một thư mực nào đó, để khi cần thì chỉ (trong VBE): File -> Import File -> duyệt tới tập tin BAS đã lưu -> chọn tập tin BAS để thêm vào tập tin Excel hiện hành -> dùng Sub InsertPicture trong tập tin hiện hành.
Bạn không nên dùng Pictures vì đôi khi gặp những lỗi khó hiểu.
InsertPicture có nhiều tùy chọn: có thể nhập ảnh vào 1 ô hoặc vùng nhiều ô mà không cần merge cells, nhập ảnh với kích thước thực, nhập ảnh center trong ô/vùng hoặc vừa khít, nhập ảnh nhưng khi mang sang máy khác thì phải mang ảnh theo hoặc nhập ảnh vĩnh viễn vào sheet để khi mang sang máy khác thì không phải mang ảnh đi theo.
Private Sub Worksheet_Change(ByVal Target As range)
Dim rng As range
If Intersect(Target, Union([A2:A10000], [D2:D10000])) Is Nothing Then Exit Sub
For Each rng In Target
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1)
Next rng
End Sub
Code trên cho phép bạn dán tên ảnh (copy từ đâu đó) hàng loạt vào cột A hoặc D kể từ dòng 2 trở đi.
Với code trên thì sau khi chèn ảnh có thể xóa ảnh trên đĩa và khi gửi cho đối tác không phải gửi ảnh theo. Nếu bạn không xóa ảnh trên đĩa và luôn gửi ảnh kèm tập tin cho đối tác thì nên chèn link thôi để tập tin nhẹ. Trong trường hợp này sửa thành
Nếu ảnh không là JPG thì sửa ".jpg" thích hợp.
Nếu ảnh ở thư mục con vd. Anh thì sửa ThisWorkbook.path & "\" thành ThisWorkbook.path & "\Anh\"
Code phục vụ 2 cột là A và D. Nếu có thêm cột thì thêm vào trong ngoặc của Union([A2:A10000], [D210000])
Cuối cùng là sub tổng quát InsertPicture: Mở tập tin -> Alt + F11 -> menu Insert -> Module -> dán code dưới vào Module vừa thêm.
Để có thể dùng sub tổng quát InsertPicture trong những tập tin tương lai thì: chọn Module (click tên Module) -> menu File -> Export File -> duyệt tới thư mục cần lưu -> lưu lại với tên nào đó.BAS
Code cho Module vừa thêm
Mã:
Sub 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)
' Target: vung nhap anh. Co the la nhieu cell
' Neu Target = Nothing thi Target = ActiveCell
' Neu original = True thi nhap anh kich thuoc thuc.
' Neu original = FALSE thi neu center = True thi anh se center trong vung Target,
' nguoc lai thi se vua khit vung Target
' LinkToFile = False thi khong can giu anh tren dia, nguoc lai bat buoc phai giu anh de moi lan mo thi co
Dim w As Double, h As Double, shp As Shape, fso As Object
If Target Is Nothing Then Set Target = ActiveCell
On Error Resume Next
Target.Parent.Shapes(Target.Address).Delete
On Error GoTo 0
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(PicFilename) Then
If LinkToFile Then
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoTrue, msoFalse, Target.left, Target.top, 0, 0)
Else
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
End If
If Not shp Is Nothing Then
With shp
If original Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
ElseIf center Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
w = Target.Width
h = w * .Height / .Width
If h > Target.Height Then
h = Target.Height
w = h * .Width / .Height
End If
.left = Target.left + (Target.Width - w) / 2
.top = Target.top + (Target.Height - h) / 2
.Width = w
.Height = h
Else
.Width = Target.Width
.Height = Target.Height
End If
shp.Name = Target.Address
shp.Placement = xlMoveAndSize
End With
End If
End If
Set fso = Nothing
End Sub
Em cảm ơn bác rất nhiều đã hướng dẫn cụ thể như vậy. Em là dân copy xài chứ không rành code được bác dành time hướng dẫn vậy em cảm ơn rất nhiều ạ vì mò trên mạng không có hoặc giải pháp không được như mong đợi.
Nói chung hơn em mong đợi nhiều lắm bác.
Em cảm ơn bác rất nhiều đã hướng dẫn cụ thể như vậy. Em là dân copy xài chứ không rành code được bác dành time hướng dẫn vậy em cảm ơn rất nhiều ạ vì mò trên mạng không có hoặc giải pháp không được như mong đợi.
Nói chung hơn em mong đợi nhiều lắm bác.
Nếu không dùng code thì càng nhẹ. Nếu file 10.000 dòng mà dùng module khi mình insert 1 cột sẽ đơ máy luôn. Nếu được anh chia sẽ cho mọi người đi.
Có một số trang họ bán tool làm báo giá 700k mà bác batman chia sẽ free cho mọi người luôn đấy. Nói chung em thấy xài rất ổn còn hay hơn tool họ quảng cáo.
Anh nghĩ chủ Topic muốn làm 1 bảng báo giá nhưng lại không nêu vấn đề cụ thể mà lại hỏi về cách chèn hình.
Nếu có đến 10.000 hình mà dùng hàm là bức tử, theo anh thì chơi vầy.
1/ Làm 1 danh mục chứa dữ liệu có tên 10.000 hình và tất cả nội dung cần như chủng loại, đặc điểm, đơn giá.
2/ 1 Folder chứa tất cả các hình với tên File tương ứng trong 1 cột chứa danh mục.
3/ Sử dụng 1 UserForm với ListBox chứa danh mục.
4/ Khi mở Form thì tìm theo chủng loại chọn và gán dữ liệu lên sheet nó tự tra và lấy hình trong Folder và gán hình vào Cell tương ứng với từng danh mục.
Nếu cột Mã dùng công thức thì khi công thức phải tính lại do tham chiếu thay đổi thì sự kiện Change không sảy ra nên code sẽ không được thực hiện. Và kết quả là ảnh không được đổi.
Code dưới đây cho phép dán hàng loạt Mã.
-------------
Trước hết về sub tổng quát InsertPicture. Bạn có thể lưu Module cùng với InsertPicture vào "thư viện" - một thư mực nào đó, để khi cần thì chỉ (trong VBE): File -> Import File -> duyệt tới tập tin BAS đã lưu -> chọn tập tin BAS để thêm vào tập tin Excel hiện hành -> dùng Sub InsertPicture trong tập tin hiện hành.
Bạn không nên dùng Pictures vì đôi khi gặp những lỗi khó hiểu.
InsertPicture có nhiều tùy chọn: có thể nhập ảnh vào 1 ô hoặc vùng nhiều ô mà không cần merge cells, nhập ảnh với kích thước thực, nhập ảnh center trong ô/vùng hoặc vừa khít, nhập ảnh nhưng khi mang sang máy khác thì phải mang ảnh theo hoặc nhập ảnh vĩnh viễn vào sheet để khi mang sang máy khác thì không phải mang ảnh đi theo.
Private Sub Worksheet_Change(ByVal Target As range)
Dim rng As range
If Intersect(Target, Union([A2:A10000], [D2:D10000])) Is Nothing Then Exit Sub
For Each rng In Target
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1)
Next rng
End Sub
Code trên cho phép bạn dán tên ảnh (copy từ đâu đó) hàng loạt vào cột A hoặc D kể từ dòng 2 trở đi.
Với code trên thì sau khi chèn ảnh có thể xóa ảnh trên đĩa và khi gửi cho đối tác không phải gửi ảnh theo. Nếu bạn không xóa ảnh trên đĩa và luôn gửi ảnh kèm tập tin cho đối tác thì nên chèn link thôi để tập tin nhẹ. Trong trường hợp này sửa thành
Nếu ảnh không là JPG thì sửa ".jpg" thích hợp.
Nếu ảnh ở thư mục con vd. Anh thì sửa ThisWorkbook.path & "\" thành ThisWorkbook.path & "\Anh\"
Code phục vụ 2 cột là A và D. Nếu có thêm cột thì thêm vào trong ngoặc của Union([A2:A10000], [D210000])
Cuối cùng là sub tổng quát InsertPicture: Mở tập tin -> Alt + F11 -> menu Insert -> Module -> dán code dưới vào Module vừa thêm.
Để có thể dùng sub tổng quát InsertPicture trong những tập tin tương lai thì: chọn Module (click tên Module) -> menu File -> Export File -> duyệt tới thư mục cần lưu -> lưu lại với tên nào đó.BAS
Code cho Module vừa thêm
Mã:
Sub 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)
' Target: vung nhap anh. Co the la nhieu cell
' Neu Target = Nothing thi Target = ActiveCell
' Neu original = True thi nhap anh kich thuoc thuc.
' Neu original = FALSE thi neu center = True thi anh se center trong vung Target,
' nguoc lai thi se vua khit vung Target
' LinkToFile = False thi khong can giu anh tren dia, nguoc lai bat buoc phai giu anh de moi lan mo thi co
Dim w As Double, h As Double, shp As Shape, fso As Object
If Target Is Nothing Then Set Target = ActiveCell
On Error Resume Next
Target.Parent.Shapes(Target.Address).Delete
On Error GoTo 0
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(PicFilename) Then
If LinkToFile Then
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoTrue, msoFalse, Target.left, Target.top, 0, 0)
Else
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
End If
If Not shp Is Nothing Then
With shp
If original Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
ElseIf center Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
w = Target.Width
h = w * .Height / .Width
If h > Target.Height Then
h = Target.Height
w = h * .Width / .Height
End If
.left = Target.left + (Target.Width - w) / 2
.top = Target.top + (Target.Height - h) / 2
.Width = w
.Height = h
Else
.Width = Target.Width
.Height = Target.Height
End If
shp.Name = Target.Address
shp.Placement = xlMoveAndSize
End With
End If
End If
Set fso = Nothing
End Sub
Bác batman ơi trường hợp em muốn mở rộng thêm cột hình thứ 3 thì code sửa lại như thế nào ạ?
Em thêm vào
If Intersect(Target, Union([A2:A10000], [D210000],[xxxxxxxxxxx])) Is Nothing Then Exit Sub
thì không chạy.
Có cách nào file hình thì vẫn ở thư mục, file excel thì không nhúng hình, khi cần hiển thị thì mới hiển thị từ file của hình, nhưng thế thì file không phải chứa hình? Bác nghĩ Excel cho phép vậy không?
Lưu ý chủ topic: file hình kiểu nhúng vào excel nên là hình nhỏ, dung lượng nhỏ thôi, còn nếu lớn mà nhiều thì file excel sẽ phình to
Có cách nào file hình thì vẫn ở thư mục, file excel thì không nhúng hình, khi cần hiển thị thì mới hiển thị từ file của hình, nhưng thế thì file không phải chứa hình? Bác nghĩ Excel cho phép vậy không?
Lưu ý chủ topic: file hình kiểu nhúng vào excel nên là hình nhỏ, dung lượng nhỏ thôi, còn nếu lớn mà nhiều thì file excel sẽ phình to
Tức nhìn vào cell cha thấy gì. Nhưng khi bạn hô: "Hiện" thì tự dưng xuất hiện hình to nguyên bản, và khi hô: "Ẩn" thì cell lại "trắng tinh"?
10000])
