Help! Cải tiến code VBA chèn hình vào file Excel

Liên hệ QC
Z

zukura

Thành viên mới
Tham gia
18/10/13
Bài viết
8
Được thích
1
Cả nhà giúp em với.

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)

Giúp em với nha.
 

File đính kèm

  • Cach chen hinh vao excel.rar
    28.4 KB · Đọc: 249
Sắp xếp theo thời gian sắp xếp theo bầu chọn
zukura đã viết:
Dung lượng đâu thành vấn đề vì ứng dụng chủ yếu gọi hình của những mặt hàng cần thiết thôi chứ không lưu hình 10.000 món hàng.
Code sẽ tự Replace những hình cũ để thay bằng hình mới khi mình gõ mã mới -> không làm phình to file excel
Nói chung mình thấy cách này quá tuyệt rồi. hihi
Nhấp chuột vào đây để mở rộng...
Đúng thế, nhưng tôi đang muốn hỏi bác batman1 về mở rộng thì có hay không thôi.
Còn bài của bạn thì gặp đúng thầy rồi, bác batman1 giúp thế là tuyệt
 
Upvote 0
tam888 đã viết:
Dạ, tức là hình không nhúng vào excel làm tăng dung lượng
Chỉ khi mở file hoặc thay đổi giá trị tên hình thì hình mới được load lên.
Nhấp chuột vào đây để mở rộng...
Thì tôi viết rồi mà
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

InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1), , , True
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
tam888 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đây là File tôi làm như đã nêu ở bài 12 sử dụng UserForm với ListBox và chọn nhập liệu một loạt.

A_1.JPG

Khi nhấn nút lấy giá và gán ảnh nó lấy hình trong Folder và gán vào.
A_2.JPGA_3.JPG
 
Lần chỉnh sửa cuối:
Upvote 0
zukura đã viết:
Dung lượng đâu thành vấn đề vì ứng dụng chủ yếu gọi hình của những mặt hàng cần thiết thôi chứ không lưu hình 10.000 món hàng.
Code sẽ tự Replace những hình cũ để thay bằng hình mới khi mình gõ mã mới -> không làm phình to file excel
Nói chung mình thấy cách này quá tuyệt rồi. hihi
Nhấp chuột vào đây để mở rộng...
Muốn không làm phình to thì
Mã: 
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1), , , True
----------
Bạn hãy nhập vào 100 mã, tức 100 hình nhưng với
Mã: 
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1)
sau đó lưu lại tập tin. Ghi dung lượng tập tin vào sổ tay. Sau đó ghi copy/paste 100 mã sang vd. K1:K100 - xóa 100 mã đã nhập ở cột A -> sửa thành
Mã: 
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1), , , True
-> copy 100 mã từ K1:K10đ -> dán vào cột A để có 100 ảnh như lần trước ở cột B -> lưu lại tập tin -> kiểm tra dung lượng tập tin.

Dung lượng lần 2 nhỏ hơn dung lượng lần 1 vì các ảnh chỉ được link vào mà không được nhúng vĩnh viễn.

Tôi thường hướng dẫn chi tiết, bỏ nhiều công sức, nhưng ít ai đọc kỹ. Phí công quá.
Bài đã được tự động gộp:

Hàng loạt hay không thì cuối cùng cũng phải có code dùng để chèn ảnh mà thôi.

Còn nếu người ta đã biết cần dán những mã nào, có thể là copy hàng loạt mã từ đâu đó, thì hiện UserForm + ListBox để mà làm gì?

Tôi nghĩ người hỏi chỉ bí code chứ rất có thể UserForm và ListBox người ta còn giỏi hơn mọi người.
 
Upvote 0
@zukura: Trong Sub Worksheet_Change có gọi InsertPicture để chèn ảnh. Mục đích đặt trong Worksheet_Change là để khi thay đổi mã trong cột A, D, G thì ảnh sẽ được chèn vào sheet. Nhưng sub InsertPicture bạn có thể gọi ở bất cứ đâu để chèn ảnh vào sheet: từ macro XYZ trong Module1, từ code trong UserForm v...v Đơn giản InsertPicture là code chèn ảnh. Còn từ đâu gọi gọi nó để chèn ảnh thì tùy nhu cầu thôi. Cốt lõi là có InsertPicture, rồi tùy nhu cầu mà gọi nó để chèn ảnh. Thế thôi.
 
Upvote 0
be09 đã viết:
Đây là File tôi làm như đã nêu ở bài 12 sử dụng UserForm với ListBox và chọn nhập liệu một loạt.

View attachment 211789

Khi nhấn nút lấy giá và gán ảnh nó lấy hình trong Folder và gán vào.
View attachment 211790View attachment 211792
Nhấp chuột vào đây để mở rộng...
Tiếc là người hỏi , đang muốn code gắn hình , và động hóa, không phải nhập
Còn list box của bác hiện nhiều thông tin quá dễ rối: bác cứ để ý các hộp thoại của các phần mềm chính quy đâu có sử dụng listbox quá nhiều cột- khi nhiều cột thì người ta phải dùng cách khác để thể hiện cùng listbox (thường list box hiện 4 5 cột là nhiều)
 
Upvote 0
tam888 đã viết:
Tiếc là người hỏi , đang muốn code gắn hình , và động hóa, không phải nhập
Còn list box của bác hiện nhiều thông tin quá dễ rối: bác cứ để ý các hộp thoại của các phần mềm chính quy đâu có sử dụng listbox quá nhiều cột- khi nhiều cột thì người ta phải dùng cách khác để thể hiện cùng listbox (thường list box hiện 4 5 cột là nhiều)
Nhấp chuột vào đây để mở rộng...
Thì đây mới chỉ là hình chứ đã có tập tin Excel đâu. Nếu tung tập tin lên thì rồi sẽ có vài bài: "Anh ơi, nhưng em đã chọn các mã trong sheet data rồi, đã copy từ xyz rồi, thì sửa code như thế nào để nhập ảnh hả anh. Vì em không muốn chọn lại lần nữa trong ListBox", "Anh ơi, nhưng em không muốn lấy giá thì sửa code thế nào" v...v
 
Upvote 0
batman1 đã viết:
Thì đây mới chỉ là hình chứ đã có tập tin Excel đâu. Nếu tung tập tin lên thì rồi sẽ có vài bài: "Anh ơi, nhưng em đã chọn các mã trong sheet data rồi, đã copy từ xyz rồi, thì sửa code như thế nào để nhập ảnh hả anh. Vì em không muốn chọn lại lần nữa trong ListBox", "Anh ơi, nhưng em không muốn lấy giá thì sửa code thế nào" v...v
Nhấp chuột vào đây để mở rộng...
Haha bác batman1 comt vui quá. Code của bác như thổi hồn vào file của em. Em đọc kĩ lắm em không hiểu sao bác hiểu đúng nhu cầu em mà cho thêm mấy chữ " , , , True " vào. Nói chung chạy ngay từ lần đầu gặp nhau không phải hỏi thêm. Chúc bác sức khỏe nhé để giúp đỡ các ae diễn đàn.
 
Upvote 0
tam888 đã viết:
Tiếc là người hỏi , đang muốn code gắn hình , và động hóa, không phải nhập
Còn list box của bác hiện nhiều thông tin quá dễ rối: bác cứ để ý các hộp thoại của các phần mềm chính quy đâu có sử dụng listbox quá nhiều cột- khi nhiều cột thì người ta phải dùng cách khác để thể hiện cùng listbox (thường list box hiện 4 5 cột là nhiều)
Nhấp chuột vào đây để mở rộng...
Bạn đọc bài 1 người ta nêu vầy "cột mã hàng" thì phải hiểu là còn những thứ khác là tên hàng hóa, kích thước, chủng loại, đơn vị tính, đơn giá ........và còn một loạt những thứ khác nữa chứ không phải chỉ riêng việc gán hình, do người ta nghĩ chưa đến nơi, đến chốn.
Đương nhiên tôi đọc và hiểu nên đưa lên một số kết quả để chủ Topic hình dung được còn những vấn đề khác liên quan chứ không đơn giản là chỉ lấy hình.
 
Upvote 0
be09 đã viết:
Bạn đọc bài 1 người ta nêu vầy "cột mã hàng" thì phải hiểu là còn những thứ khác là tên hàng hóa, kích thước, chủng loại, đơn vị tính, đơn giá ........và còn một loạt những thứ khác nữa chứ không phải chỉ riêng việc gán hình, do người ta nghĩ chưa đến nơi, đến chốn.
Đương nhiên tôi đọc và hiểu nên đưa lên một số kết quả để chủ Topic hình dung được còn những vấn đề khác liên quan chứ không đơn giản là chỉ lấy hình.
Nhấp chuột vào đây để mở rộng...
Bác cứ suy luận thế thì còn nhiều thứ khác nữa. Xét bao giờ hết. Nhưng thôi chủ topic đã thỏa mãn với các bài trên rồi.
 
Upvote 0
tam888 đã viết:
Bác cứ suy luận thế thì còn nhiều thứ khác nữa. Xét bao giờ hết. Nhưng thôi chủ topic đã thỏa mãn với các bài trên rồi.
Nhấp chuột vào đây để mở rộng...
Tôi thì nghĩ công việc của người ta thì người ta phải biết người ta cần những thông tin gì, cần những cột nào. Chả cần ai phải gợi ý hình dung gì cả.

Nếu người ta không biết thì chắc chắn người ta sẽ hỏi. Còn nếu không hỏi thì không nên cho là người ta không biết gì.

Cái người ta hỏi thì chắc chắn người ta không biết. Nhưng cái người ta không hỏi thì không loại trừ khả năng là người ta còn giỏi hơn mình. Đừng vì người ta hỏi một vấn đề mà mặc định là người ta chả biết gì.
 
Lần chỉnh sửa cuối:
Upvote 0
Kính gửi Giải Pháp Excel
Tôi học trên YouTube và làm file Excel với đoạn Code theo hướng dẫn.
Mục đích là khi thay đổi chọn Số CMND tại sheet Form sẽ hiện hình người tương ứng
Tôi không biết VBA chỉ làm theo hướng dẫn nhưng không được, nhờ các anh em giúp với
Xin chân thành cảm ơn
Xin gửi kèm file
 

File đính kèm

  • GPEXCEL.rar
    72.7 KB · Đọc: 35
Upvote 0
LeMinhhHa đã viết:
Kính gửi Giải Pháp Excel
Tôi học trên YouTube và làm file Excel với đoạn Code theo hướng dẫn.
Mục đích là khi thay đổi chọn Số CMND tại sheet Form sẽ hiện hình người tương ứng
Tôi không biết VBA chỉ làm theo hướng dẫn nhưng không được, nhờ các anh em giúp với
Xin chân thành cảm ơn
Xin gửi kèm file
Nhấp chuột vào đây để mở rộng...

Có anh em nào giúp tôi được không, xin cám ơn
 
Upvote 0
LeMinhhHa đã viết:
Có anh em nào giúp tôi được không, xin cám ơn
Nhấp chuột vào đây để mở rộng...
Bạn nên đưa cái mẫu đầy đủ lên và cũng nên nêu rõ gán hình chỗ nào để các thành viên hiểu mới giúp được, chứ nữa vời như bạn thì người giúp rất nại sửa code khi bạn thay đổi ý.
 
Lần chỉnh sửa cuối:
Upvote 0
LeMinhhHa đã viết:
Có anh em nào giúp tôi được không, xin cám ơn
Nhấp chuột vào đây để mở rộng...
Nếu nói về code của bạn thì có vài cái sai cơ bản
1. Không phải
Mã: 
Set Rng = Sheets(1).Range(Sheets(1).[B5], Sheets(1).[B11].End(xlUp))
mà ít ra phải là
Mã: 
Set Rng = Sheets(1).Range(Sheets(1).[B5], Sheets(1).[B65535].End(xlUp))

hoặc viết gọn

With Me.Parent.Worksheets("List")
    Set Rng = .Range(.[B5], .[B65535].End(xlUp))
End With

2. Không phải
Mã: 
Picname = ThisWorkbook.Path & "\Foto" & Rng.Find(Target).Offset(, 5)
mà là
Mã: 
Picname = ThisWorkbook.Path & "\Foto\" & Rng.Find(Target).Offset(, 5)

3. Không phải
Mã: 
With ActiveSheet.Picture.Insert(Picname)
mà là
Mã: 
With ActiveSheet.Pictures.Insert(Picname)

4. Không phải
Mã: 
Top = [F6].Top
mà là
Mã: 
.Top = [F6].Top

5. Tốt hơn nên
- thay
Mã: 
Sheets(2).Shapes([F6].Address).Delete
bằng
Mã: 
Me.Shapes(Me.[F6].Address).Delete
- bỏ
Mã: 
[F6].Seclect
...
Activesheets.Shapes("$F$6").IncrementTop = 0
Activesheets.Shapes("$F$6").IncrementLeft = 0

- thay các [F6] bằng Me.[F6]

------
Nếu nói về các code khác thì trên GPE có nhiều.
 
Upvote 0
batman1 đã viết:
Nếu nói về code của bạn thì có vài cái sai cơ bản
1. Không phải
Mã: 
Set Rng = Sheets(1).Range(Sheets(1).[B5], Sheets(1).[B11].End(xlUp))
mà ít ra phải là
Mã: 
Set Rng = Sheets(1).Range(Sheets(1).[B5], Sheets(1).[B65535].End(xlUp))

hoặc viết gọn

With Me.Parent.Worksheets("List")
    Set Rng = .Range(.[B5], .[B65535].End(xlUp))
End With

2. Không phải
Mã: 
Picname = ThisWorkbook.Path & "\Foto" & Rng.Find(Target).Offset(, 5)
mà là
Mã: 
Picname = ThisWorkbook.Path & "\Foto\" & Rng.Find(Target).Offset(, 5)

3. Không phải
Mã: 
With ActiveSheet.Picture.Insert(Picname)
mà là
Mã: 
With ActiveSheet.Pictures.Insert(Picname)

4. Không phải
Mã: 
Top = [F6].Top
mà là
Mã: 
.Top = [F6].Top

5. Tốt hơn nên
- thay
Mã: 
Sheets(2).Shapes([F6].Address).Delete
bằng
Mã: 
Me.Shapes(Me.[F6].Address).Delete
- bỏ
Mã: 
[F6].Seclect
...
Activesheets.Shapes("$F$6").IncrementTop = 0
Activesheets.Shapes("$F$6").IncrementLeft = 0

- thay các [F6] bằng Me.[F6]

------
Nếu nói về các code khác thì trên GPE có nhiều.
Nhấp chuột vào đây để mở rộng...

Xin cám ơn các anh em đã giúp đỡ
 
Upvote 0
Nếu muốn chèn ảnh từ 1 ô tính trong file excel khác thì làm thế nào các bác(thay việc lấy ảnh từ file ảnh trong foder mà lấy từ 1 file excel khác ấy ah)
 
Upvote 0
Upvote 0
batman1 đã viế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.

Tôi nhìn tập tin của bạn thì thấy bạn muốn nhập ảnh vừa khít với vùng (ảnh sẽ bị biến dạng nếu tỉ lệ cao/rộng của vùng <> cao/rộng của ảnh).
Code
Mã: 
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
Mã: 
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1), , , True
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], [D2:D10000])

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
[/
[/QUOTE]
Nhấp chuột vào đây để mở rộng...

batman1 đã viế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.

Tôi nhìn tập tin của bạn thì thấy bạn muốn nhập ảnh vừa khít với vùng (ảnh sẽ bị biến dạng nếu tỉ lệ cao/rộng của vùng <> cao/rộng của ảnh).
Code
Mã: 
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
Mã: 
InsertPicture ThisWorkbook.path & "\" & rng.Value & ".jpg", rng.Offset(0, 1), , , True
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], [D2:D10000])

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
Nhấp chuột vào đây để mở rộng...
Em chào các bác, các bác cho em hỏi nếu muốn vùng chọn hiện ảnh là nhiều cell thì mã code viết như nào ạ. Ví dụ em muốn gộp ô nhập mã là từ N17:N25 và ô chèn ảnh là O17:O25, tương tự gộp như vậy cho các cell dưới cột N và chèn ảnh cột O. Em chưa thạo mong các bác giúp đỡ ạ!!!
 

File đính kèm

  • anh excel.jpg
    anh excel.jpg
    78.1 KB · Đọc: 11
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

O
  • Question
Tìm số thứ tự của sheet trong workbook có nhiều sheets
Trả lời
11
Đọc
3K
VetMini
V
Manhhung90
Liệt kê các ngày cộng dồn mong muốn vào 1 ô. Nhờ mọi người giúp mình ạ.
2 3 4
Trả lời
62
Đọc
732
VetMini
V
C
Hàm đánh số thứ tự như không đánh dữ liệu trùng
Trả lời
7
Đọc
8K
Trang Tuyet Ngoc Nhi
T
H
  • Question
Xóa toàn bộ các dòng giống nhau ở 1 cột
    • Cười
Trả lời
8
Đọc
44
hadoan-pap
H
Hai Lúa Miền Tây
  • Question
Hàm chuyển dữ liệu từ cột sang dòng (Hàm melt + wide_to_long của Python trong Excel)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
445
tranhungdao12a3
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
4
Đọc
452
PhanTuHuong
PhanTuHuong
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
163
Đọc
8K
trannguyen197
T
vova2209
  • Question
Tìm địa chỉ ô với 2đk và chuyển thành links
Trả lời
12
Đọc
204
vova2209
vova2209
tvcneo
  • Question
Nhờ Anh Chị Em giúp mình cách để tạo macro giống như trong file này
Trả lời
17
Đọc
219
huuthang_bd
huuthang_bd
T
Có phải lỗi Excel?
Trả lời
8
Đọc
9K
dinhthang8709
D
T
Công thức lấy dữ liệu
Trả lời
3
Đọc
115
HUONGHCKT
H
S
  • Question
Nhờ anh chị giúp em hàm ngẫu nhiên với tổng là 1 số
Trả lời
6
Đọc
149
SA_DQ
SA_DQ
L
Tự động nhảy số tham chiếu khi sang sheet mới
Trả lời
5
Đọc
5K
Romantic92
R
TieuLong2708
Danh sách lịch cắt người trực
Trả lời
0
Đọc
36
TieuLong2708
TieuLong2708
C
  • Question
Xin giúp đỡ Code kiểm tra và copy dữ liệu từ sheet 1 sang sheet 2
2
Trả lời
21
Đọc
627
conan1
C
H
  • Question
Mong giúp code chuyển file xls sang xlsx hàng loạt và không lỗi số liệu
Trả lời
16
Đọc
369
Hoàng Tuấn 868
H
jenny12345
tổng hợp dữ liệu theo tháng
Trả lời
10
Đọc
246
Hoàng Tuấn 868
H
S
Trợ giúp công thức lấy dữ liệu
Trả lời
7
Đọc
133
Hoàng Tuấn 868
H
M
Không gõ được tiếng Việt trên Excel
Trả lời
4
Đọc
117
MKC
M
H
Có thể mở file Excel mới sẽ Zoom mặc định 150% không?
Trả lời
3
Đọc
145
hieug126
H
Xem thêm…

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