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

Liên hệ QC
anhtuan1066

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.jpg và AT04.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
Sắp xếp theo thời gian sắp xếp theo bầu chọn
ndu96081631 đã viết:
Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:
Mã: 
Function CommPic(ByVal PicPath As String, Optional ByVal PicCel As Range, _
                Optional ByVal ScaleWidth As Single = 1, _
                Optional ByVal ScaleHeight As Single = 1) As String
  Dim mRng As Range, cmt As Comment, fso As Object, bChk As Boolean
  On Error Resume Next
  Application.Volatile
  Set fso = CreateObject("Scripting.FileSystemObject")
  If PicCel Is Nothing Then Set PicCel = Application.ThisCell
  PicCel(1, 1).Comment.Delete
  If Left(PicPath, 7) = "http://" Then
    bChk = URLExists(PicPath)
  Else
    bChk = fso.FileExists(PicPath)
    If bChk = False Then
      PicPath = ThisWorkbook.Path & "\" & PicPath
      bChk = fso.FileExists(PicPath)
    End If
  End If
  If bChk Then
    If PicCel(1, 1).Comment Is Nothing Then PicCel(1, 1).AddComment
    PicCel(1, 1).Comment.Text vbLf
    Set mRng = PicCel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = PicCel(1, 1)
    Set cmt = mRng(1, 1).Comment
    cmt.Visible = True
    With cmt.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.ForeColor.RGB = PicCel.Interior.Color
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle
      .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle
      .Fill.UserPicture PicPath
    End With
  End If
End Function
Private Function URLExists(ByVal URL As String) As Boolean
  Application.Volatile
  On Error Resume Next
  If Left(UCase(URL), 7) <> "HTTP://" Then URL = "http://" & URL
  With CreateObject("MSXML2.XMLHTTP")
    .Open "HEAD", URL, False: .send
    URLExists = .Status = 200
  End With
End Function
Khả năng của hàm:
- Như ý anh: Nếu đường dẫn không tồn tại, sẽ xóa Comment
- Cho phép chèn hình có trong ổ đĩa máy tính hoặc hình trên Web
- Tự động thay đổi size hình và dịch chuyển theo cell (khi cell thay đổi kích thước, chỉ cần bấm F9 để cập nhật)
- Cho phép thu nhỏ, phóng to hình tùy ý. Ví dụ =CommPic(A1, , 80%, 80%) có nghĩa là thu nhỏ chiều ngang và chiều dọc 80% so với cell (mặc định là 100%)
Những khả năng mở rộng chỉ là dạng Optional, nếu anh không thích dùng vẫn có thể bỏ qua không cần khai báo. Ví dụ anh chỉ muốn chèn hình vào cell B1, với đương dẫn nằm ở A1, vậy chỉ cần gõ vào B1 thế này là đủ: =CommPic(A1) mà không cần quan tâm những đối số phía sau
Nhấp chuột vào đây để mở rộng...

Vậy là điều ngày xưa thẩy bảo không làm được giờ đã không thành hiện thực rồi :-=
 
Upvote 0
Xin giúp đỡ vì cần add một lượng hình lớn nên file excel quá nặng, có cách nào để giảm dung lượng hình khi add vào excel hay phải giảm trước khi add vậy ?
 
Upvote 0
Tôi muốn đoạn VBA chèn hình ảnh bằng các ký tự vào trong cel: Ví dụ tôi điền chữ A vào ô nào đó thì hình "A.jpg" được tự động điền vào ô đó. bác nào cao thủ xin giúp đỡ, xin cảm ơn.
 
Upvote 0
Em tải về fille ComPic nhưng tại sao khi em print preview thì lại không thấy ảnh
 
Lần chỉnh sửa cuối:
Upvote 0
hdm.tp đã viết:
Em tải về fille ComPic nhưng tại sao khi em print preview thì lại không thấy ảnh
Nhấp chuột vào đây để mở rộng...
Mã: 
[COLOR=#ff0000][B]        ActiveSheet.PageSetup.PrintComments = xlPrintInPlace[/B][/COLOR]
        With cmt.Shape
            .LockAspectRatio = msoFalse
            .Placement = xlMoveAndSize
            .Shadow.Visible = msoFalse
            .Line.ForeColor.RGB = PicCel.Interior.Color
            .AutoShapeType = msoShapeRectangle
            .Left = mRng.Left
            .Top = mRng.Top
            .Width = mRng.Width
            .Height = mRng.Height
            .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle
            .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle
            .Fill.UserPicture PicPath
        .PrintObject = True
        End With
thêm dòng màu đỏ đó thử xem
 
Upvote 0
Chào thầy ndu96081631,
Thay vì chèn hình vào cell thì mình có code nào chèn hình vào ô vuông cho sẵn không?
Ví dụ trong hợp đồng, mình thay đổi mã nv hoặc tên thì hình trong ô vuông đó sẽ thay đổi theo.
Cám ơn thầy đã chia sẻ.
 
Upvote 0
anhtuan1066 đã viết:
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.jpg và AT04.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
Nhấp chuột vào đây để mở rộng...
quá tuyệt vời. trân thành cảm ơn bác
 
Upvote 0
anhtuan1066 đã viết:
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.jpg và AT04.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
Nhấp chuột vào đây để mở rộng...
thầy cho em hỏi có cách nào để ảnh ở một thư mục khác không (cho nó gọn)
 
Upvote 0
anhtuan1066 đã viết:
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.jpg và AT04.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
Nhấp chuột vào đây để mở rộng...
Thầy cho em hỏi, hướng dẫn của thầy em áp dụng vào công việc rất ok nhưng có 1 vấn về trầm trọng, nếu khoảng 50 ảnh thì ok, nhưng khối lượng ảnh của em trên 1000 ảnh. khi em đư avof thư mục khoảng trên 150 ảnh thì file không thể chạy nhanh được, thường xuyên bị đóng đột ngột. em đã nén ảnh, giảm kích thước để mỗi ảnh chỉ khoảng 30 Kb tuy nhiên vẫn không giải quyết được. Mong thầy chỉ cách để khắc phục. cảm ơn thầy nhiều
 
Upvote 0
nvtnet đã viết:
Thầy cho em hỏi, hướng dẫn của thầy em áp dụng vào công việc rất ok nhưng có 1 vấn về trầm trọng, nếu khoảng 50 ảnh thì ok, nhưng khối lượng ảnh của em trên 1000 ảnh. khi em đư avof thư mục khoảng trên 150 ảnh thì file không thể chạy nhanh được, thường xuyên bị đóng đột ngột. em đã nén ảnh, giảm kích thước để mỗi ảnh chỉ khoảng 30 Kb tuy nhiên vẫn không giải quyết được. Mong thầy chỉ cách để khắc phục. cảm ơn thầy nhiều
Nhấp chuột vào đây để mở rộng...
mình thấy là không còn cách nào khác đâu. nếu bạn chèn xong rồi thì tại ô bạn gõ công thức để chèn ảnh ấy. xóa công thức đi cho rồi.
 
Upvote 0
langtuchungtinh360 đã viết:
mình thấy là không còn cách nào khác đâu. nếu bạn chèn xong rồi thì tại ô bạn gõ công thức để chèn ảnh ấy. xóa công thức đi cho rồi.
Nhấp chuột vào đây để mở rộng...
mình cũng đang áp dụng cách này. tức là làm thêm một lẹnh nếu gõ số 0 thi chèn đường dẫn nào để hiện ảnh, nếu gõ 1 thì cho đường dẫn ảnh bằng rỗng, nhưng như vậy thì cũng như ko chèn nên mình xóa luôn cho đỡ nhọc. mong sao có cách cải thiện
 
Upvote 0
anhtuan1066 đã viết:
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.jpg và AT04.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
Nhấp chuột vào đây để mở rộng...
Hi, các bác cho em hỏi :
Bài toán của em là : có 1danh sách các nhân viên (mã nhân viên và tên nhân viên) ở sheet "danh sach" và ảnh các nhân viên được lưu theo mã nhân viên (G001, G002..... .*JPG). Muốn chèn ảnh nhân viên ở sheet "in anh" thì chỉ cần gõ mã nhân viên vào là tự nhảy tên,ảnh thì phải làm thế nào ạ?
Em xin cảm ơn!
 

File đính kèm

  • vi du.rar
    217 KB · Đọc: 53
Upvote 0
cảm ơn bài viết của bạn, nhưng bạn cho mình hỏi thêm một vấn đề thế này, mình không biết phải làm thế nào:
mình có một cái bàn, mình chụp hình từ khi còn trong bao bì, mở bao bì và chụp mọi góc nhìn của bàn, khoảng 5-7 tấm hình
rồi một cái tủ minh cũng chụp như thế cũng khoảng 10-11 tấm hình
vậy làm thế nào để lấy hình của bàn hay tủ thì tất cả đều hiện ra và theo thứ tự
 
Upvote 0
sao mình làm hoài mà k được, giúp mình với
 

File đính kèm

  • Book1.xlsx
    10.3 KB · Đọc: 7
Upvote 0
anhtuan1066 đã viết:
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.jpg và AT04.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
Nhấp chuột vào đây để mở rộng...
hihi, bạn có thể chỉ lại dể hiểu cho mình k, cái này mình làm mà k được
cảm ơn bạn nhiều
 

File đính kèm

  • New folder.rar
    288.5 KB · Đọc: 10
Upvote 0
Bác có số điện thoại không cho e hỏi với ạ?. Em đọc như thế này nhưng vẫn chưa hiểu cách làm
 
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ấy lại file excel bị lưu đè
Trả lời
3
Đọc
51
HOANGVO797969
H
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
15
Đọc
324
hiv174
H
kiencuong030184
  • Question
Nhờ giúp đỡ về ẩn dòng, cột có điều kiện
Trả lời
1
Đọc
42
BuiQuangThuan
B
T
V/v tối ưu xử lý đoạn code
Trả lời
1
Đọc
54
SA_DQ
SA_DQ
kiet317
Helloooooooooooo
    • Phẫn nộ
    • Buồn
Trả lời
1
Đọc
42
Hoàng Tuấn 868
H
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