Chèn hình vào cell bằng hàm tự tạo

Liên hệ QC

anhtuan1066

Thành viên gạo cội
Tham gia
10/3/07
Bài viết
5,802
Được thích
6,905
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:
Mã:
Function CommPic(Pic As String, Cel As Range) As String
  On Error Resume Next
  Application.Volatile
  Cel.Comment.Delete
  If Cel.Comment Is Nothing Then Cel.AddComment
  Cel.Comment.Text vbLf
  With Cel.Comment.Shape
    .Left = Cel.Left: .Top = Cel.Top: .Visible = True
    .Width = Cel.Width: .Height = Cel.Height
    .Fill.UserPicture Pic
  End With
End Function
Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpgAT04.jpg)
- Gõ công thức này vào cell B3:
PHP:
=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)
- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính
 

File đính kèm

  • TestComPic.rar
    68.2 KB · Đọc: 7,595
Anh Tuấn cho hỏi, sao em dùng Mailmer trong word thì không xuất ra hình được.
Ví dụ: em có 01 file excell với dữ liệu gồm: Hoten, diachi, ngaysinh, hinhanh. Nhưng không dùng mailmer để xuất hình ảnh ra word được.
Cảm ơn anh và các bạn.
 
Upvote 0
Em muốn dùng file excell để mailmerger sang Word nhưng sao không được. Giúp em với.
 
Upvote 0
Nhờ các cao thủ giúp em tạo 01 file danh sách khách hàng (file đính kèm) trong đó 2 cột đánh dấu màu vàng (cột A, F) khi thay đổi nội dung 2 cột này thì nội dung các cột khác cũng thay đổi theo, em cũng muốn trong Sheet DATA (bị dấu đi rồi) có chèn hình ảnh tương ứng với từng khách hàng và dĩ nhiên ở Sheet kết quả cũng hiển thị hình thị hình ảnh này luôn.
Đồng thời em cũng muốn dữ liệu từ Sheet kết quả này dùng Mailmer để xuất ra word luôn.
Cảm ơn các cao thủ trước.

http://upfile.vn/98601e?shared
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bạn Anh Tuấn rất nhiều. Nhưng sao khi Printview thì không có hình, và khi in ra cũng không có hình?
 
Upvote 0
Anh ơi sao em làm giống cách anh chỉ nhưng ko ra hình mà ra #Name? làm sao để khắc phục vậy anh...thanks anh
 

File đính kèm

  • Book2.xlsx
    8.7 KB · Đọc: 36
Upvote 0
Chào các bạn, tôi dùng cái này chèn hình tự động thì OK nhưng khi tạo chú thích cho hình bằng autoshape thì cái chú thích lại nằm dưới tấm hình chèn trong comment. Tôi đã format autoshape chọn Bring To Fron nhưng khi tắt file mở lại thì nó vẫn như cũ. Nhờ các bạn them cái code cho tấm hình trong comment luôn ở tình trạng Send To Back được không ạ.. Cảm ơn rất nhiều.
 
Upvote 0
Chào các bạn, tôi dùng cái này chèn hình tự động thì OK nhưng khi tạo chú thích cho hình bằng autoshape thì cái chú thích lại nằm dưới tấm hình chèn trong comment. Tôi đã format autoshape chọn Bring To Fron nhưng khi tắt file mở lại thì nó vẫn như cũ. Nhờ các bạn them cái code cho tấm hình trong comment luôn ở tình trạng Send To Back được không ạ.. Cảm ơn rất nhiều.

Nghĩ cũng lạ thiệt! Excel 2003 có thể làm cho AutoShapes nằm trên hoặc dưới Comment tùy ý, còn Excel 2010 thì chẳng biết làm cách nào cho thằng AutoShapes nằm trên comment cả
 
Upvote 0
Tên các file hình của bạn thiếu đuôi ".jpg". Thêm vào phần đó là OK
 
Upvote 0
Nhân tiện có bạn thắc mắc về hàm này liên quan đến Merge cell tại đây:
http://www.giaiphapexcel.com/forum/...đồi-hình-ảnh-theo-danh-sách-và-insert-copy-đc
Tôi cải tiến lại hàm này như sau:
Mã:
Function CommPic(Pic As String, Cel As Range) As String
  Dim mRng As Range
  On Error Resume Next
  Application.Volatile
  Cel(1, 1).Comment.Delete
  If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
  Cel(1, 1).Comment.Text vbLf
  Set mRng = Cel(1, 1).MergeArea
  If mRng Is Nothing Then Set mRng = Cel(1, 1)
  With Cel(1, 1).Comment.Shape
    .Shadow.Visible = msoFalse '<--- Thêm vào nếu không muốn có Shadow
    .Line.Visible = msoFalse      '<--- Thêm vào nếu không muốn có đường viền
    .AutoShapeType = msoShapeRectangle  '<--- Thêm vào để che mũi tên đỏ trong cell
    .Left = mRng.Left: .Top = mRng.Top: .Visible = True
    .Width = mRng.Width: .Height = mRng.Height
    .Fill.UserPicture Pic
  End With
End Function
Cú pháp sử dụng vẫn như cũ

Hi Anhtuan,
Tôi sử dụng hàm tự tạo để chèn ảnh, tuy nhiên gửi cho đối tác không đọc được ảnh. Tuấn chỉ giúp có cách nào mà gửi sang các máy tính bất kỳ vẫn xem được ảnh không nhé. Cảm ơn Tuấn!

Br,
Tran Anh Tuan
tuantab@gmail.com
 
Upvote 0
Các bác giúp em với ạ. Sao em trộn thư từ file chứa ảnh này thì các ảnh đều không hiển thị trong Word được ạ. -\\/.
 
Upvote 0
Đầu tiên xin cám ơn anh về bài viết hay. Anh cho hỏi thêm nếu trường hợp mình lấy link ảnh là Shape có được không? vì em muốn chèn tất cả ảnh vào trong excel để tiện cho công việc của em hơn. Xin cảm ơn anh trước

Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:
Mã:
Function CommPic(Pic As String, Cel As Range) As String
  On Error Resume Next
  Application.Volatile
  Cel.Comment.Delete
  If Cel.Comment Is Nothing Then Cel.AddComment
  Cel.Comment.Text vbLf
  With Cel.Comment.Shape
    .Left = Cel.Left: .Top = Cel.Top: .Visible = True
    .Width = Cel.Width: .Height = Cel.Height
    .Fill.UserPicture Pic
  End With
End Function
Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpgAT04.jpg)
- Gõ công thức này vào cell B3:
PHP:
=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)
- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính
 
Upvote 0
bài này hay quá. nhưng bác ơi em có một vấn đề này mong bác giúp. đó là ví dụ em chưa định dạng bức ảnh vậy nên kích cỡ của nó khác nhau giờ em muốn bức ảnh khi vào có định dạng sẵn là 4*6 cm bác nghiên cứu dùm em với a. cám ơn bác nhiều.
 
Upvote 0
bài này hay quá. nhưng bác ơi em có một vấn đề này mong bác giúp. đó là ví dụ em chưa định dạng bức ảnh vậy nên kích cỡ của nó khác nhau giờ em muốn bức ảnh khi vào có định dạng sẵn là 4*6 cm bác nghiên cứu dùm em với a. cám ơn bác nhiều.

Kích thước của hình sẽ được tự động chỉnh theo kích thước của cell (cell ta gõ công thức). Vậy bạn chỉ cần chỉnh kích thước cell sao cho vừa ý là được rồi
 
Upvote 0
vâng ạ cám ơn bác đã chỉ giáo . bác ơi cho em hỏi làm sao để khoá bức ảnh trong khung commen em gửi email nhưng người nhận không nhìn thấy bức ảnh ạ.
 
Upvote 0
Chào cả nhà!
Cho tôi hỏi: Tôi làm theo cách trong topic này ở trong Excel 2003 thì được, nhưng khi chèn code này:
Option ExplicitFunction CommPic(Pic As String, Cel As Range) As String
Dim mRng As Range
On Error Resume Next
Application.Volatile
Cel(1, 1).Comment.Delete
If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
Cel(1, 1).Comment.Text vbLf
Set mRng = Cel(1, 1).MergeArea
If mRng Is Nothing Then Set mRng = Cel(1, 1)
With Cel(1, 1).Comment.Shape
.Shadow.Visible = msoFalse
.Line.Visible = msoFalse
.AutoShapeType = msoShapeRectangle
.Left = mRng.Left: .Top = mRng.Top: .Visible = True
.Width = mRng.Width: .Height = mRng.Height
.Fill.UserPicture Pic
End With
End Function


vào excel 2013 thì khi lưu lại báo lỗi như hình đính kèm, giờ làm như thế nào?
 

File đính kèm

  • Screenshot (9).jpg
    Screenshot (9).jpg
    21.8 KB · Đọc: 179
Upvote 0
Chào cả nhà!
Cho tôi hỏi: Tôi làm theo cách trong topic này ở trong Excel 2003 thì được, nhưng khi chèn code này:
Option ExplicitFunction CommPic(Pic As String, Cel As Range) As String
Dim mRng As Range
On Error Resume Next
Application.Volatile
Cel(1, 1).Comment.Delete
If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
Cel(1, 1).Comment.Text vbLf
Set mRng = Cel(1, 1).MergeArea
If mRng Is Nothing Then Set mRng = Cel(1, 1)
With Cel(1, 1).Comment.Shape
.Shadow.Visible = msoFalse
.Line.Visible = msoFalse
.AutoShapeType = msoShapeRectangle
.Left = mRng.Left: .Top = mRng.Top: .Visible = True
.Width = mRng.Width: .Height = mRng.Height
.Fill.UserPicture Pic
End With
End Function


vào excel 2013 thì khi lưu lại báo lỗi như hình đính kèm, giờ làm như thế nào?
Từ Excel 2007 trở lên đều thế cả: Với file có chứa macro, phải lưu theo định dạng XLSM. Nếu "cố tình" lưu theo định dạng XLSX thì Excel sẽ hiện thông báo lỗi như trên, và nếu "cố tình" bấm nút Yes thì xem như.. tiêu đời ---> Code mất sạch
Phiền phức hơn Excel 2003 vậy đấy, tuy nhiên chức năng này cũng có cái hay của nó: Với file có virus, chỉ cần Save As theo định dạng XLSX thì virus.. chết ngắt
 
Upvote 0
Hi Anhtuan,
Tôi sử dụng hàm tự tạo để chèn ảnh, tuy nhiên gửi cho đối tác không đọc được ảnh. Tuấn chỉ giúp có cách nào mà gửi sang các máy tính bất kỳ vẫn xem được ảnh không nhé. Cảm ơn Tuấn!

Br,
Tran Anh Tuan
tuantab@gmail.com

Bạn làm xong rồi save as sang excel 2003-2007 gửi cho đối tác OK nhé
 
Upvote 0
Web KT
Back
Top Bottom