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

anhtuan1066 · 9/7/11

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

batman1 · 18/6/18

bjboyn00b đã viết:
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

Rất tiếc là code của tôi nhập ảnh vĩnh viễn.

Bạn có các lựa chọn:
1. Chọn bằng tay các ảnh -> nhấn DELETE trên bàn phím -> lưu lại.
Bạn chỉ chèn 1 ảnh thì chọn và nhấn DELETE thôi. Có khó khăn gì đâu?

2. Thẻ Home -> nhấn nút Find & Select -> chọn Goto To Special ... -> đánh dấu chọn Objects -> OK -> nhấn DELETE

Cách này là xóa tất cả các object trên sheet. Nếu ngoài ảnh còn có các đối tượng khác thì không dùng.

3. Cho bây giờ và mãi về sau bạn nên sửa trong code của InsertPicture
Sửa

Mã:

Target.Parent.Shapes("r" & Target.Row & "c" & Target.Column).Delete

thành

Mã:

Target.Parent.Shapes(Target.Address).Delete

Sửa

Mã:

shp.Name = "r" & Target.Row & "c" & Target.Column

thành

Mã:

shp.Name = Target.Address

Bây giờ nếu muốn xóa các ảnh đã được chèn bằng InsertPicture thì chạy code

Mã:

Sub delete_pic()
Dim shname As String, sh As Worksheet, shp As Shape, rng As Range
    shname = Application.InputBox("Nhap ten sheet co anh can xoa", "Ten sheet", , , , , , 2)
    If shname = "" Then Exit Sub
    On Error Resume Next
    Set sh = ThisWorkbook.Worksheets(shname)
    If Err.Number Then Exit Sub
    
    For Each shp In sh.Shapes
        Set rng = sh.Range(shp.Name)
        If Err.Number Then
            Err.Clear
        Else
            sh.Shapes(shp.Name).Delete
        End If
    Next shp
End Sub

bjboyn00b · 18/6/18

batman1 đã viết:
Rất tiếc là code của tôi nhập ảnh vĩnh viễn.

Bạn có các lựa chọn:
1. Chọn bằng tay các ảnh -> nhấn DELETE trên bàn phím -> lưu lại.
Bạn chỉ chèn 1 ảnh thì chọn và nhấn DELETE thôi. Có khó khăn gì đâu?

2. Thẻ Home -> nhấn nút Find & Select -> chọn Goto To Special ... -> đánh dấu chọn Objects -> OK -> nhấn DELETE

Cách này là xóa tất cả các object trên sheet. Nếu ngoài ảnh còn có các đối tượng khác thì không dùng.

3. Cho bây giờ và mãi về sau bạn nên sửa trong code của InsertPicture
Sửa

Mã:

Target.Parent.Shapes("r" & Target.Row & "c" & Target.Column).Delete

thành

Mã:

Target.Parent.Shapes(Target.Address).Delete

Sửa

Mã:

shp.Name = "r" & Target.Row & "c" & Target.Column

thành

Mã:

shp.Name = Target.Address

Bây giờ nếu muốn xóa các ảnh đã được chèn bằng InsertPicture thì chạy code

Mã:

Sub delete_pic() Dim shname As String, sh As Worksheet, shp As Shape, rng As Range shname = Application.InputBox("Nhap ten sheet co anh can xoa", "Ten sheet", , , , , , 2) If shname = "" Then Exit Sub On Error Resume Next Set sh = ThisWorkbook.Worksheets(shname) If Err.Number Then Exit Sub For Each shp In sh.Shapes Set rng = sh.Range(shp.Name) If Err.Number Then Err.Clear Else sh.Shapes(shp.Name).Delete End If Next shp End Sub

Cám ơn bác rất nhiều

sevt.01 · 18/6/18

Em đính kèm lại file em cần chèn anh, Mong các anh hướng dẫn thêm. Echưa chèn được ảnh vào file trên nhiều dòng và cột.
Mới chỉ chèn được khi nó ở trong 1 cell.
cảm ơn các anh!

batman1 · 19/6/18

sevt.01 đã viết:
Em đính kèm lại file em cần chèn anh, Mong các anh hướng dẫn thêm. Echưa chèn được ảnh vào file trên nhiều dòng và cột.
Mới chỉ chèn được khi nó ở trong 1 cell.
cảm ơn các anh!

Nhờ người khác thì cũng phải mô tả cho người ta hiểu.

Nhập ảnh vào đâu? Tên ảnh lấy ở đâu? Nhập khi nào?

Không có mô tả thì tôi tự cho ví dụ, rồi hãy tự thích ứng với tập tin thực. Code có sẵn, ví dụ cũng cho sẵn

https://www.giaiphapexcel.com/diend...-vào-khung-textbox-bằng-vba.84107/post-863151

thế mà không làm được thì bó tay toàn tập.

1. Vùng cần nhập ảnh không bắt buộc phải merge. Hiện tại ví dụ nhập ảnh vào C25:H32. Do cần phải biết lấy ảnh nào cho C25:H32 nên tôi nhập 11540859 vào C25. Tức code sẽ tìm ảnh 11540859.JPG để nhập.

Mã:

Sub Button2_Click()
    With Worksheets("file")
        InsertPicture ThisWorkbook.Path & "\file anh\" & .Range("C25").Value & ".jpg", .Range("C25:H32")
    End With
End Sub

Tức code sẽ tìm ảnh trong thư mục "file anh". Nếu tên thư mục thay đổi thì tự sửa trong code. Thư mục "file anh" phải nằm cùng thư mục với tập tin Excel. Nếu khác thì tự sửa trong code.

Code coi là đang nhập ảnh trong sheet "file". Nếu tên khác thì tự sửa.

2. Trong code ví dụ tôi nhập vào C25 chỉ tên mà không có định dạng JPG vì code có thể tự thêm vào. Tự sửa theo ý muốn.

3. Code InsertPicture và Sub Button2_Click ở trong Module1.

sevt.01 · 19/6/18

Em cảm ơn anh, em đã làm được ạ.

cuahang0000 · 3/8/18

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

Gởi Thầy ndu96081631

Xin lỗi vì em hơi dốt VBA, cho em hỏi có cách nào em đã để hình ở 1 sheet riêng biệt trong file Excel (vd: mỗi hình là 1 ô ở sheet "hinhanh")
Giờ em muốn khi em gõ mã ở sheet "xu ly" thì hình hiện tương ứng !
Em đọc kỹ các bài post nhưng không thấy đề cập việc lấy hình ở trong cùng 1 work book (em đang nói phương án nhúng hình vào file luôn)

ndu96081631 · 3/8/18

cuahang0000 đã viết:
Em đọc kỹ các bài post nhưng không thấy đề cập việc lấy hình ở trong cùng 1 work book (em đang nói phương án nhúng hình vào file luôn)

Có chứ! Bạn xem file nhé (hàm CommPic đã cải tiến)
Điều quan trọng là bạn phải đặt tên hình trùng với mã, sau đó dùng hàm này tại B2

Mã:

=CommPic("hinh!"&A2,,0.8,0.8)

Con số 0.8 là độ phóng to thu nhỏ hình so với cell. Nếu không ghi gì có nghĩa là số ấy =1, vừa khít hình với cell

cuahang0000 · 3/8/18

Cám ơn bác ndu96081631 nhiều lắm !!!
Đã đúng như ý muốn !!

tueyennhi · 14/9/18

ndu96081631 đã viết:
Có chứ! Bạn xem file nhé (hàm CommPic đã cải tiến)
Điều quan trọng là bạn phải đặt tên hình trùng với mã, sau đó dùng hàm này tại B2

Mã:

=CommPic("hinh!"&A2,,0.8,0.8)

Con số 0.8 là độ phóng to thu nhỏ hình so với cell. Nếu không ghi gì có nghĩa là số ấy =1, vừa khít hình với cell

Thầy cho em hỏi chèn hình từ trên mạng thì làm thế nào? Em copy đường link và đánh Compic("Đường link") thì không được.

ndu96081631 · 14/9/18

tueyennhi đã viết:
Thầy cho em hỏi chèn hình từ trên mạng thì làm thế nào? Em copy đường link và đánh Compic("Đường link") thì không được.

Bất cứ "đường link" nào mà bạn có thể chèn bằng tay vào bảng tính được thì sẽ có thể dùng nó với code
Ví dụ:

Mã:

=CommPic("http://i1101.photobucket.com/albums/g424/atmt17/SinhNhatGPE239.jpg")

Còn "đường link" của bạn thuộc dạng gì?

tueyennhi · 14/9/18

ndu96081631 đã viết:
Bất cứ "đường link" nào mà bạn có thể chèn bằng tay vào bảng tính được thì sẽ có thể dùng nó với code
Ví dụ:

Mã:

=CommPic("http://i1101.photobucket.com/albums/g424/atmt17/SinhNhatGPE239.jpg")

Còn "đường link" của bạn thuộc dạng gì?

Lạ nhỉ, của thầy ăn ngay, của em thì không được.
https://ins.dkn.tv/wp-content/uploads/2016/08/tuoi-heo-1.jpg

ndu96081631 · 14/9/18

tueyennhi đã viết:
Lạ nhỉ, của thầy ăn ngay, của em thì không được.
https://ins.dkn.tv/wp-content/uploads/2016/08/tuoi-heo-1.jpg

Thật ra không phải lỗi tại bạn mà là lỗi ở hàm. Khi viết nó, tôi cũng ít có điều kiện để test. Giờ sửa lại

tueyennhi · 14/9/18

ndu96081631 đã viết:
Thật ra không phải lỗi tại bạn mà là lỗi ở hàm. Khi viết nó, tôi cũng ít có điều kiện để test. Giờ sửa lại

Cảm ơn thầy nhé

lenamproduct · 27/10/18

ndu96081631 đã viết:
Bạn chỉ cần thay đổi chiều cao, chiều rộng của cell mà bạn đang gõ hàm rồi bấm F9 là tự động hình sẽ được chỉnh theo kích thước mới của cell
Thử xem

Chào a. Em có xem cách a chèn hình ảnh vào cố định vào exel cố định bằng hàm. Bài 5 năm trước. Không biết giờ a viết chỉnh hàm, cho mình gõ trực tiếp đường linh trong ô để hình ảnh từ đường dẫn nhảy vào ô luôn chưa ạ? Cách trước của a là pải ghi đường dẫn sang ô nhớ phụ. Và cho em hỏi thêm, là ví dụ mình có sheet2, nhưng mình muốn lấy hình ảnh từ ô B5 sheet1 (B5 là ô đã chèn hình ảnh từ file ổ cứng) thì mình có cách nào không ạ? Mail em Lenamproduct@gmail.com !
Thank anh!

lenamproduct · 27/10/18

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:

chào anh. E làm theo a ok ạ. Nhưng khi mình xuất dữ liệu sang Pdf, hình ảnh k sang đc. Anh có cách nào chỉ giúp e với để PDF có thể hiện thị ảnh với ạ!

tueyennhi · 20/11/18

lenamproduct đã viết:
chào anh. E làm theo a ok ạ. Nhưng khi mình xuất dữ liệu sang Pdf, hình ảnh k sang đc. Anh có cách nào chỉ giúp e với để PDF có thể hiện thị ảnh với ạ!

Trong Page Setup của Excel phần Comments bạn chỉnh thành As dispayed on sheet nhé. Sau đó save đuôi pdf là được.

N Khánh · 22/11/18

Nhưng hiện tại muốn chỉ ảnh to ra thì phải thay đổi kích thước của ô, nhưng file excel này của em muốn ảnh to chỉ có thể merge các ô lại, vì nếu kéo chỉnh ô cell sẽ bị hỏng cấu trúc. Nhưng khi merge các ô lại thì ảnh vẫn chỉ bé bằng ô ban đầu ạ. Mong mọi người giúp mình với !!!

batman1 · 22/11/18

N Khánh đã viết:
Nhưng hiện tại muốn chỉ ảnh to ra thì phải thay đổi kích thước của ô, nhưng file excel này của em muốn ảnh to chỉ có thể merge các ô lại, vì nếu kéo chỉnh ô cell sẽ bị hỏng cấu trúc. Nhưng khi merge các ô lại thì ảnh vẫn chỉ bé bằng ô ban đầu ạ. Mong mọi người giúp mình với !!!

Tức bạn đã chọn cho mình một cách chèn ảnh, cụ thể là dưới dạng Comment. Bây giờ bạn muốn người ta uốn nó theo ý bạn là ảnh phải to ra mà vẫn giữ nguyên kích thước hàng cột?

Nếu không nhất thiết là comment thì đăng bài ở chủ đề mới, nêu rõ yêu cầu, có minh họa và xin hướng dẫn. Cách chèn thì để cho người giúp tự chọn. Đừng theo kiểu cứ bắt chọn một cô rồi bắt người khác phải làm sao cho cô đó "* vượt ngọn cây"

N Khánh · 22/11/18

batman1 đã viết:
Tức bạn đã chọn cho mình một cách chèn ảnh, cụ thể là dưới dạng Comment. Bây giờ bạn muốn người ta uốn nó theo ý bạn là ảnh phải to ra mà vẫn giữ nguyên kích thước hàng cột?

Nếu không nhất thiết là comment thì đăng bài ở chủ đề mới, nêu rõ yêu cầu, có minh họa và xin hướng dẫn. Cách chèn thì để cho người giúp tự chọn. Đừng theo kiểu cứ bắt chọn một cô rồi bắt người khác phải làm sao cho cô đó "* vượt ngọn cây"

https://www.giaiphapexcel.com/diendan/threads/giúp-em-sửa-code-chèn-ảnh-vào-excel.139187/
bác giúp em với

matbao8x · 7/6/19

Mình đã đọc hết 11 trang topic này xin phép đào mồ và tổng hợp lại như sau:
Có 2 cách cách chèn hình vào excel.
1. Chèn hình vĩnh viễn vào excel bằng các lệnh chèn hình vào ô. có 2 hàm của 2 bác đã làm là: 199 và 159
2. Chèn hình vào comment của chủ topic: bài 1
Mình dùng bài 159 phù hợp hơn, nhưng chưa biết code nào để bring to front hoặc send to back, hoặc frame hình lại vì mình bố trí hình chồng lên nhau. Nếu ae có đọc bài nhờ hỗ trợ chỉnh code với nhé:

Mã:

Option Explicit
Public Function InsertPic(ByVal PicPath As String, _
                          Optional ByVal PicCel As Range, _
                          Optional ByVal xScaleWidth As Double = 0.99, _
                          Optional ByVal xScaleHeight As Double = 0.99, _
                          Optional xStretch As Byte = 1) As String
'--------------------------------------------------------------------------------
'CHU THICH LENH: CHEN ANH VAO CELL
'HUONG DAN:
'Tham so                    Chu thich                                       Vi du
'PicPath                    Duong dan file anh                              D:\Picture.png hoac http://taihinhanhdep.xyz/wp-content/uploads/2015/11/anh-dep-cho-dien-thoai-2.jpg
'PicCel                     Vung chen anh                                   C1:F10
'xScaleWidth,xScaleHeight   Thu phong Anh theo ty le: mac dinh 1               1,1
'xStretch                   0:  Keo gian hinh anh vua khit voi vung chen anh
'                           1:  Chen anh theo kich thuoc that cua anh
'--------------------------------------------------------------------------------
    On Error Resume Next
    Dim mRng As Range
    Dim shp As Shape
    Dim cmt As Comment
    Dim fso As Object, oShel As Object
    Dim xArrTam As Variant, xFormat As Variant, xPath As Variant
    Dim xNamePicture As String, txt As String
    Dim i As Byte, j As Byte
    Dim TyLe As Double
    Application.Volatile
    Set fso = CreateObject("Scripting.FileSystemObject")
    'CHON O CHEN ANH NGAY O CO CONG THUC (NEU CHUA CHON VUNG CHEN ANH)
    If PicCel Is Nothing Then Set PicCel = Application.ThisCell
    If PicCel.Cells(1, 1).MergeCells Then Set mRng = PicCel(1, 1).MergeArea Else Set mRng = PicCel
    With Application.ThisCell
        If .Comment Is Nothing Then .AddComment
        Set cmt = .Comment
        With cmt
            PicCel.Worksheet.Shapes.Range(Array(.Text)).Delete
            .Text "[" & PicCel.Address(0, 0) & "]" & fso.GetBaseName(PicPath)
            .Visible = False
            With .Shape
                .Top = Application.ThisCell.Top
                .Left = Application.ThisCell.Left + Application.ThisCell.Width
                .Height = 0
                .Width = 0
                .Line.ForeColor.RGB = Application.ThisCell.Interior.Color
            End With
        End With
    End With
    Err.Clear
    If Not fso.FileExists(PicPath) Then
        xFormat = Array("JPG", "JPEG", "JPE", "TIFF", "GIF", "PNG", "BMP")    'dinh dang anh
        xNamePicture = fso.GetBaseName(PicPath)    'ten anh
        Set oShel = CreateObject("Shell.Application").Namespace(&H27&).Self    'thu muc Picture
        xPath = Array(fso.GetParentFolderName(PicPath), ActiveWorkbook.Path, oShel.Path)    'duong dan
        'tim duong dan phu hop voi ten anh
        For i = LBound(xPath) To UBound(xPath)
            If Len(xPath(i)) > 0 Then
                For j = LBound(xFormat) To UBound(xFormat)
                    PicPath = xPath(i) & "\" & xNamePicture & "." & xFormat(j)
                    If fso.FileExists(PicPath) Then
                        PicPath = fso.GetFile(PicPath).ShortPath
                        GoTo Nex
                    End If
                Next j
            End If
        Next i
        InsertPic = ""
        GoTo Thoat
    End If
Nex:
    InsertPic = "  "    'PicPath
    ReDim xArrTam(3)
    'lay kich thuoc va vi tri dat anh
    'lay kich thuoc anh: ?1024 x 768? ~ Width x Height
    Set oShel = CreateObject("Shell.Application")
    If fso.FileExists(PicPath) Then
        With oShel.Namespace("" & fso.GetParentFolderName(PicPath) & "")
            txt = .Getdetailsof(.ParseName("" & fso.GetFile(PicPath).Name & ""), 31)
            xFormat = Split(Mid(txt, 2, Len(txt) - 2), " x ")
        End With
    End If
    If xStretch = 1 Then    'keo gian hinh anh vua o
        'tinh toan ty le cua anh so voi Cells
        TyLe = Application.WorksheetFunction.Min(mRng.Width / CDbl(xFormat(0)), mRng.Height / CDbl(xFormat(1)))
        xArrTam(0) = mRng.Left + (mRng.Width - (CDbl(xFormat(0)) * TyLe)) / 2
        xArrTam(1) = mRng.Top + (mRng.Height - (CDbl(xFormat(1)) * TyLe)) / 2
        xArrTam(2) = CDbl(xFormat(0)) * TyLe
        xArrTam(3) = CDbl(xFormat(1)) * TyLe
    Else    'chinh theo ty le hinh anh
LayTyLe:
        xArrTam(0) = mRng.Left
        xArrTam(1) = mRng.Top
        xArrTam(2) = mRng.Width
        xArrTam(3) = mRng.Height
    End If
    'dinh dang anh
    Set shp = PicCel.Worksheet.Shapes.AddPicture(PicPath, False, True, 1, 1, xFormat(0), xFormat(1))
    'ActiveSheet.Shapes.AddPicture("D:\1.jpg", False, True, left, top, width, heigh)
    With shp
        .Name = "[" & PicCel.Address(0, 0) & "]" & fso.GetBaseName(PicPath)
        .LockAspectRatio = msoFalse
        .Shadow.Visible = msoFalse
        .Line.ForeColor.RGB = PicCel.Interior.Color
        .AutoShapeType = msoShapeRectangle
        .Left = xArrTam(0)
        .Top = xArrTam(1)
        .Width = xArrTam(2)
        .Height = xArrTam(3)
        .ScaleWidth xScaleWidth, msoFalse, msoScaleFromMiddle
        .ScaleHeight xScaleHeight, msoFalse, msoScaleFromMiddle
        .visible = true
    End With
Thoat:
    Set oShel = Nothing: Set fso = Nothing
    Set shp = Nothing: Set cmt = Nothing
    Set PicCel = Nothing: Set mRng = Nothing
End Function

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

Thành viên gạo cội

File đính kèm

Thành viên gạo cội

Thành viên chính thức

Thành viên mới

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Huyền thoại GPE

File đính kèm

Thành viên mới

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

File đính kèm

Thành viên tích cực

Thành viên mới

Thành viên mới

Thành viên tích cực

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới