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

[anhtuan1066]

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:

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:

=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

 

[anh79_ct]

Bài viết hay, nhưng có cách nào lấy hình ảnh khi các file ảnh nằm khác thư mục với file excel không vậy?
Mình có vài ngàn ảnh chi tiết chứa trên server nhưng muốn làm file excel này nằm ở thư mục khác. Mình muốn file excel này link với thư mục chứa hình ảnh đó.
Cám ơn chủ thớt nhé!

 

[ndu96081631]

Bài viết hay, nhưng có cách nào lấy hình ảnh khi các file ảnh nằm khác thư mục với file excel không vậy?
Mình có vài ngàn ảnh chi tiết chứa trên server nhưng muốn làm file excel này nằm ở thư mục khác. Mình muốn file excel này link với thư mục chứa hình ảnh đó.
Cám ơn chủ thớt nhé!

Hình nằm chỗ nào thì bạn cứ chỉ đường dẫn chính xác vào hàm là được chứ gì. Đâu có bắt buộc hình phải nằm trong thư mục chứa file Excel

 

[anh79_ct]

Cám ơn anh nhiều nhé. Mình làm được rồi.
Nhưng có câu này muốn mở rộng thêm chút là có cách nào làm tương tự với file pdf không. Ví dụ mình gõ mã số trùng tên file pdf vào một cell, rồi double click vào cell sẽ mở file pdf lưu sẵn trên 1 thư mục ở sever. Hoặc có thể tự động tạo link đến thư mục đó, để nhấn vào mở file pdf đó luôn.
Dĩ nhiên các file pdf sẽ chứa trong cùng 1 thư mục nào đó trên server.
Xin lỗi nếu câu hỏi này không thuộc chuyên mục này nhé .

 

[befaint]

Nhưng có câu này muốn mở rộng thêm chút là có cách nào làm tương tự với file pdf không. Ví dụ mình gõ mã số trùng tên file pdf vào một cell, rồi double click vào cell sẽ mở file pdf lưu sẵn trên 1 thư mục ở sever. Hoặc có thể tự động tạo link đến thư mục đó, để nhấn vào mở file pdf đó luôn.

Từ khóa: Hyperlink

 

[anh79_ct]

Wow, thật là ảo diệu . Cám ơn bạn "befaint" nhé!

 

[be_09]

Cám ơn anh nhiều nhé. Mình làm được rồi.
Nhưng có câu này muốn mở rộng thêm chút là có cách nào làm tương tự với file pdf không. Ví dụ mình gõ mã số trùng tên file pdf vào một cell, rồi double click vào cell sẽ mở file pdf lưu sẵn trên 1 thư mục ở sever. Hoặc có thể tự động tạo link đến thư mục đó, để nhấn vào mở file pdf đó luôn.
Dĩ nhiên các file pdf sẽ chứa trong cùng 1 thư mục nào đó trên server.
Xin lỗi nếu câu hỏi này không thuộc chuyên mục này nhé .

Đương nhiên là được, nhưng hỏi ở đây thì lạc chủ đề, vào Link sau để tham khảo hoặc hỏi tiếp nhé.
http://www.giaiphapexcel.com/diendan/threads/tạo-hyper-link-cho-1-loạt-file-của-1-folder.81852/

 

[ThaiDieuAnh]

Bây giờ em muốn chèn ảnh vào Textbox trên Form, rồi từ form mình xuất hình ảnh xuống cell được không ạ?

 

[Hai Lúa Miền Tây]

Bây giờ em muốn chèn ảnh vào Textbox trên Form, rồi từ form mình xuất hình ảnh xuống cell được không ạ?

Ai mà đưa hình vào Textbox, người ta phải load hình vào Image control chứ bạn.

 

[ThaiDieuAnh]

Ai mà đưa hình vào Textbox, người ta phải load hình vào Image control chứ bạn.

Vâng ạ, nhờ bác sửa và thay Textbox bằng Image control giúp em được không ạ, cảm ơn bác

 

[Hai Lúa Miền Tây]

Vâng ạ, nhờ bác sửa và thay Textbox bằng Image control giúp em được không ạ, cảm ơn bác

Dùng code như sau:

 Image1.Picture = LoadPicture(DuongDanDenFileHinhAnh)

 

[ThaiDieuAnh]

Dùng code như sau:

 Image1.Picture = LoadPicture(DuongDanDenFileHinhAnh)

Xấu hổ quá, em thay các kiểu vẫn không hiển thị bác Hai Lúa Miền Tây ạ

 

[ndu96081631]

Tự dưng chèn hình vào form, rồi lại xuất xuống sheet? Không hiểu tại sao lại đi lòng vòng cho mệt thế không biết?

 

[anh79_ct]

File download từ diễn đàn vẫn là .xls nhưng có thể chèn "Module". Nhưng sao khi mình tạo 1 Module trên file excel mới và chèn đoạn code này vào thì sau đó excel bắt save lại với macro (.xlsm) thì hàm này mới chạy được cho lần mở file tiếp theo, còn không thì chỉ dùng được cho lần mở hiện tại.

Nhưng nếu save với loại .xlsm thì file rất nặng. Có cách nào vẫn giữ loại .xlsx nhưng hàm trong Module vẫn có hiệu lực không?

 

[befaint]

Có cách nào vẫn giữ loại .xlsx nhưng hàm trong Module vẫn có hiệu lực không?

1. Không
2. Thử *.xlsb
3. Add-Ins

 

[anh79_ct]

Vậy sao file compic.xls (đuôi .xls)down trên diễn đàn về vẫn chạy được hàm trong module thế nhỉ?

 

[ndu96081631]

Vậy sao file compic.xls (đuôi .xls)down trên diễn đàn về vẫn chạy được hàm trong module thế nhỉ?

Thì có ai nói rằng đuôi xls không chạy được code đâu chứ
???
Chỉ đuôi xlsx mới không thể chứa code thôi. Vậy bạn đã biết rồi đấy, tính sao thì tùy

 

[bjboyn00b]

File commpic rất hay nhưng mình đang gặp khó ở chỗ là ảnh mình muốn hiển thị sẽ là 1 vùng chứ không phải trong 1 ô ( các phần phía trên mình không điều chỉnh được vì đã theo form biểu ) .
Mong được giúp đỡ

 

[be_09]

File commpic rất hay nhưng mình đang gặp khó ở chỗ là ảnh mình muốn hiển thị sẽ là 1 vùng chứ không phải trong 1 ô ( các phần phía trên mình không điều chỉnh được vì đã theo form biểu ) .
Mong được giúp đỡ

Nghĩ cũng ngộ, lấy dữ liệu ngay trong File bài 197 cho thuận tiện quản lý mà lại đi lấy dữ liệu từ File này FIXED ASSETS REGISTER-STANDARD1.xlsx

 

[batman1]

File commpic rất hay nhưng mình đang gặp khó ở chỗ là ảnh mình muốn hiển thị sẽ là 1 vùng chứ không phải trong 1 ô

1. Với code dưới thì ảnh được nhập vĩnh viễn vào sheet. Khi mang tập tin sang máy khác thì không phải mang ảnh đi theo.
Với code

.Fill.UserPicture Pic

thì khi xóa ảnh trên đĩa hoặc sang máy khác không có ảnh đó thì trên sheet sẽ rỗng. Cho tới cuối đời vẫn phải giữ ảnh trên đĩa. Nếu nhu cầu của bạn đúng là thế thì ngừng đọc tại đây và không dùng code. Vì code nhập ảnh vào sheet vĩnh viễn. Sau đó bạn có thể xóa ảnh trên đĩa hoặc mang sang máy khác.

2. Bạn có nhiều lựa chọn: nhập vào vùng 1 ô hoặc nhiều ô, nhập vừa khít với vùng, nhập Center trong vùng và nhập ảnh thực.

3. Thêm 1 Module (Atl+F11 -> Insert -> Module) và dán code dưới vào

Sub InsertPicture(ByVal PicFilename As String, Optional Target As range = Nothing, _
                Optional original As Boolean = False, Optional center 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
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("r" & Target.Row & "c" & Target.Column).Delete
    On Error GoTo 0
  
    Set fso = CreateObject("Scripting.FileSystemObject")
  
    If fso.FileExists(PicFilename) Then
        Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
        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 = "r" & Target.Row & "c" & Target.Column
                shp.Placement = xlMoveAndSize
            End With
        End If
    End If
   
     Set fso = Nothing
End Sub

 

[bjboyn00b]

1. Với code dưới thì ảnh được nhập vĩnh viễn vào sheet. Khi mang tập tin sang máy khác thì không phải mang ảnh đi theo.
Với code

.Fill.UserPicture Pic

thì khi xóa ảnh trên đĩa hoặc sang máy khác không có ảnh đó thì trên sheet sẽ rỗng. Cho tới cuối đời vẫn phải giữ ảnh trên đĩa. Nếu nhu cầu của bạn đúng là thế thì ngừng đọc tại đây và không dùng code. Vì code nhập ảnh vào sheet vĩnh viễn. Sau đó bạn có thể xóa ảnh trên đĩa hoặc mang sang máy khác.

2. Bạn có nhiều lựa chọn: nhập vào vùng 1 ô hoặc nhiều ô, nhập vừa khít với vùng, nhập Center trong vùng và nhập ảnh thực.

3. Thêm 1 Module (Atl+F11 -> Insert -> Module) và dán code dưới vào

Sub InsertPicture(ByVal PicFilename As String, Optional Target As range = Nothing, _
                Optional original As Boolean = False, Optional center 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
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("r" & Target.Row & "c" & Target.Column).Delete
    On Error GoTo 0
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    If fso.FileExists(PicFilename) Then
        Set shp = .Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
        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 = "r" & Target.Row & "c" & Target.Column
                shp.Placement = xlMoveAndSize
            End With
        End If
    End If
  
     Set fso = Nothing
End Sub

Cảm ơn bác
Công việc của em là quản lý tài sản, cty có khoảng 10000 tài sản cố định, hàng tháng có khoảng trăm tài sản mua mới , mỗi tài sản có mã riêng, em định chụp ảnh về đặt tên ảnh là tên mã tài sản, sau đó dùng hàm để gọi thông tin tài sản, bao gồm cả ảnh ra trong file #197 , sau đấy in ra để lưu bản cứng mỗi tài sản 1 tờ , thế nên file của em không cần lưu ảnh vĩnh viễn, chỉ gọi ảnh của tài sản nào cần thôi bác.
Ví dụ như file em gửi thì mã tài sản ở ô B12 , còn ảnh sẽ hiện ở A23:F44