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
Em phát hiện ra code này bị xung đột với checkbox. Khi nhấn checkbox để tạo giá trị true/false file lập tức bị out khỏi excel.

Các anh xem có thể tìm ra nguyên nhân để khắc phục được không ;;;;;;;;;;;. Code này rất hay em đang định dùng vào công việc của mình. cảm ơn các anh!

Tôi chẳng thấy xung đột gì cả? Có chăng bạn không có những hình và đường dẫn tới hình đó mà thôi.
 
Upvote 0
Em phát hiện ra code này bị xung đột với checkbox. Khi nhấn checkbox để tạo giá trị true/false file lập tức bị out khỏi excel.

Các anh xem có thể tìm ra nguyên nhân để khắc phục được không ;;;;;;;;;;;. Code này rất hay em đang định dùng vào công việc của mình. cảm ơn các anh!

Bạn dùng Excel 2007 chăng?
Nhiều khi thằng 2007 xuất hiện những lỗi tào lao mà ta không thể biết được đó là lỗi gì cả
 
Upvote 0
Có đâu Thầy! Em vẫn đang xài thằng 2007 đó thôi, đâu có lỗi gì đâu?

Tôi chỉ đoán vậy thôi
Vì file ấy của tôi, chắc chắc không lỗi gì rồi... nhưng tôi tình nghi tác giả đang áp dụng vào 1 file khác có thêm nhiều thành phần khác (như nhiều format, nhiều công thức...) và khi thêm cái checkbox trên thì vừa đúng lỗi xuất hiện
 
Upvote 0
em vừa kiểm tra lại trên excel 2010 thì bình thường, chỉ bị lỗi khi chạy trên excel 2003 thôi ạ.
 
Upvote 0
wow, qua hay. Nhưng mình gặp lỗi này. nếu sửa đc thì ok.
1. khi chen hinh xong, save lai, neu click vao hinh, hinh se chay ra khoi cell. phai nhan F9 de hinh cho ve vi tri dung cua no.
2. Có cách nào sau khi chen hinh xong, save lại với lựa chọn đóng gói luôn hình vào file (tất nhiên file sẽ có dung lượng lớn)

>> Da chinh dc. chon lenh show all command la dc.
 
Lần chỉnh sửa cuối:
Upvote 0
Khuyết điểm của phương pháp này là khi hide row, cac command nhay lung tung.
Ap dung tốt với file ít hình ảnh. Nhưng với file có vài trăm hình, file sẽ chạy khá ì ạch.
 
Upvote 0
Upvote 0
Sorry các anh nhé. Em muốn hỏi là copy ảnh vào 1 sheets trong file đó. Bây giờ sử dụng lệnh để lấy nguồn file ảnh ở sheets đó.
 
Upvote 0
gửi các anh.
em gửi file lên các anh xem giúp em nhé.
 

File đính kèm

  • Mau.rar
    402.1 KB · Đọc: 109
Upvote 0
gửi các anh.
em gửi file lên các anh xem giúp em nhé.

Thế bạn muốn chèn hình vào chổ nào? Trong cái khung vuông vuông bên sheet MauKM chăng?
Thêm nữa: Tôi để ý trong file của bạn có trường hợp 1 mã sản phẩm nhưng nhận được nhiều hàng khuyến mãi (chẳng hạn vừa bàn phím, vừa quạt điện). Trường hợp này ta sẽ "show" hình như thế nào đây?
 
Upvote 0
Vâng. Em muốn chèn hình vào trong khung đó ở bên sheet mauKM. Chỗ nào cũng được miễn làm sao có đầy đủ các hình. Khi chèn xong em sẽ tự điều chình kích thước, vị trí cho phù hợp và đẹp mắt.
trong file đó có mã sản phẩm được khuyến mại 1 sản phẩm khác, có mã hàng không được khuyến mại gì, có mã hàng được nhiều sản phẩm KM. Em muốn Nếu mã sản phẩm nào được khuyến mại gì thì sẽ chèn hình ảnh tương ứng.
 
Upvote 0
Vâng. Em muốn chèn hình vào trong khung đó ở bên sheet mauKM. Chỗ nào cũng được miễn làm sao có đầy đủ các hình. Khi chèn xong em sẽ tự điều chình kích thước, vị trí cho phù hợp và đẹp mắt.
trong file đó có mã sản phẩm được khuyến mại 1 sản phẩm khác, có mã hàng không được khuyến mại gì, có mã hàng được nhiều sản phẩm KM. Em muốn Nếu mã sản phẩm nào được khuyến mại gì thì sẽ chèn hình ảnh tương ứng.

Xem file thử có đúng ý bạn không nha!
Chọn mã sản phẩm tại cell A3, hình sẽ tự thay đổi
(nhớ Enable macros nhé)
 

File đính kèm

  • Mau.rar
    433.4 KB · Đọc: 489
Upvote 0
Gửi Anh!
Hàm này em đã áp dụng rồi nhưng có nhược điểm là :
- Nếu di chuyển và thay đổi kích thước hình đó thì sẽ bị ẩn luôn. Nhấn F9 thì hình lại quay lại khunh mặc định.
- Em muốn chèn hình và thay đổi kích thước mà không bị ẩn đi.
 
Upvote 0
Gửi Anh!
Hàm này em đã áp dụng rồi nhưng có nhược điểm là :
- Nếu di chuyển và thay đổi kích thước hình đó thì sẽ bị ẩn luôn. Nhấn F9 thì hình lại quay lại khunh mặc định.
- Em muốn chèn hình và thay đổi kích thước mà không bị ẩn đi.

Không phải biến mất là do di chuyển hay thay đổi kích thước. Biến mất khi bạn click vào ảnh (sẩy ra khi bạn di chuyển hoặc thay đổi kích thước) và sau đó click vào cell khác. Bạn cứ thử "lỡ nhầm" click vào ảnh rồi sau đó không di chuyển và thay đổi kích thước, tiếp theo click vào cell khác. Ảnh sẽ biến mất.
 
Upvote 0
Như vậy thì rất khó xử lý rồi, Vì trong file này, việc di chuyển và thay đổi kích thước phải sử dụng liên tục. Có cách nào nữa không hả các anh chị.
 
Upvote 0
Như vậy thì rất khó xử lý rồi, Vì trong file này, việc di chuyển và thay đổi kích thước phải sử dụng liên tục. Có cách nào nữa không hả các anh chị.

Hay ta chơi Picture?
Mã:
Function PicFit(ByVal PictureFileName As String, Optional ByVal TargetCell As range) As String
  On Error Resume Next
  If TargetCell Is Nothing Then Set TargetCell = Application.ThisCell
    TargetCell.Worksheet.Shapes(TargetCell.Address).Delete
    If CreateObject("Scripting.FileSystemObject").fileExists(PictureFileName) Then
        TargetCell.Select
        With TargetCell.Worksheet.Pictures.Insert(PictureFileName)
            .Name = TargetCell.Address
            .ShapeRange.LockAspectRatio = msoFalse
            .Left = TargetCell.Left
            .Top = TargetCell.Top
            .Width = TargetCell.Width
            .Height = TargetCell.Height
        End With
    End If
End Function
 

File đính kèm

  • Mau.rar
    438.1 KB · Đọc: 341
Upvote 0
Gửi Anh!
Hàm này em đã áp dụng rồi nhưng có nhược điểm là :
- Nếu di chuyển và thay đổi kích thước hình đó thì sẽ bị ẩn luôn. Nhấn F9 thì hình lại quay lại khunh mặc định.
- Em muốn chèn hình và thay đổi kích thước mà không bị ẩn đi.

Cái đó dễ thôi. Thêm đoạn này ở trên With.. End With là được:
Mã:
Cel(1, 1).Comment.Visible = True
Gửi lại file nhé
 

File đính kèm

  • Mau.rar
    441.1 KB · Đọc: 348
Upvote 0
Web KT
Back
Top Bottom