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,593
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 là code của tôi nhập ảnh vĩnh viễn.

Bạn có các lựa chọn:
1. Chọn bằng tay các ảnh -> nhấn DELETE trên bàn phím -> lưu lại.
Bạn chỉ chèn 1 ảnh thì chọn và nhấn DELETE thôi. Có khó khăn gì đâu?

2. Thẻ Home -> nhấn nút Find & Select -> chọn Goto To Special ... -> đánh dấu chọn Objects -> OK -> nhấn DELETE

Cách này là xóa tất cả các object trên sheet. Nếu ngoài ảnh còn có các đối tượng khác thì không dùng.

3. Cho bây giờ và mãi về sau bạn nên sửa trong code của InsertPicture
Sửa
Mã:
Target.Parent.Shapes("r" & Target.Row & "c" & Target.Column).Delete
thành
Mã:
Target.Parent.Shapes(Target.Address).Delete

Sửa
Mã:
shp.Name = "r" & Target.Row & "c" & Target.Column
thành
Mã:
shp.Name = Target.Address

Bây giờ nếu muốn xóa các ảnh đã được chèn bằng InsertPicture thì chạ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
 
Upvote 0
Rất tiếc là code của tôi nhập ảnh vĩnh viễn.

Bạn có các lựa chọn:
1. Chọn bằng tay các ảnh -> nhấn DELETE trên bàn phím -> lưu lại.
Bạn chỉ chèn 1 ảnh thì chọn và nhấn DELETE thôi. Có khó khăn gì đâu?

2. Thẻ Home -> nhấn nút Find & Select -> chọn Goto To Special ... -> đánh dấu chọn Objects -> OK -> nhấn DELETE

Cách này là xóa tất cả các object trên sheet. Nếu ngoài ảnh còn có các đối tượng khác thì không dùng.

3. Cho bây giờ và mãi về sau bạn nên sửa trong code của InsertPicture
Sửa
Mã:
Target.Parent.Shapes("r" & Target.Row & "c" & Target.Column).Delete
thành
Mã:
Target.Parent.Shapes(Target.Address).Delete

Sửa
Mã:
shp.Name = "r" & Target.Row & "c" & Target.Column
thành
Mã:
shp.Name = Target.Address

Bây giờ nếu muốn xóa các ảnh đã được chèn bằng InsertPicture thì chạ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 :D
 
Upvote 0
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!
 

File đính kèm

  • File chen anh.rar
    3.1 MB · Đọc: 20
Upvote 0
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 khác thì cũng phải mô tả cho người ta hiểu.

Nhập ảnh vào đâu? Tên ảnh lấy ở đâu? Nhập khi nào?

Không có mô tả thì tôi tự cho ví dụ, rồi hãy tự thích ứng với tập tin thực. Code có sẵn, ví dụ cũng cho sẵn

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

thế mà không làm được thì bó tay toàn tập.

1. Vùng cần nhập ảnh không bắt buộc phải merge. Hiện tại ví dụ nhập ảnh vào C25:H32. Do cần phải biết lấy ảnh nào cho C25:H32 nên tôi nhập 11540859 vào C25. Tức code sẽ tìm ả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 sẽ tìm ảnh trong thư mục "file anh". Nếu tên thư mục thay đổi thì tự sửa trong code. Thư mục "file anh" phải nằm cùng thư mục với tập tin Excel. Nếu khác thì tự sửa trong code.

Code coi là đang nhập ảnh trong sheet "file". Nếu tên khác thì tự sửa.

2. Trong code ví dụ tôi nhập vào C25 chỉ tên mà không có định dạng JPG vì code có thể tự thêm vào. Tự sửa theo ý muốn.

3. Code InsertPicture và Sub Button2_Click ở trong Module1.
 

File đính kèm

  • File chen anh.rar
    3.1 MB · Đọc: 87
Upvote 0
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)
 

File đính kèm

  • cuahangtest.xlsm
    51.3 KB · Đọc: 6
Upvote 0
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
 

File đính kèm

  • cuahangtest.xlsm
    120 KB · Đọc: 90
Upvote 0
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.
 
Upvote 0
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ì?
 
Upvote 0
Upvote 0

File đính kèm

  • ComPic_Final.xlsb
    124 KB · Đọc: 117
Upvote 0
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!
 
Upvote 0
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 ạ!
 
Upvote 0
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.
 
Upvote 0
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 !!!
 
Upvote 0
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 bạn đã chọn cho mình một cách chèn ảnh, cụ thể là dưới dạng Comment. Bây giờ bạn muốn người ta uốn nó theo ý bạn là ảnh phải to ra mà vẫn giữ nguyên kích thước hàng cột?

Nếu không nhất thiết là comment thì đăng bài ở chủ đề mới, nêu rõ yêu cầu, có minh họa và xin hướng dẫn. Cách chèn thì để cho người giúp tự chọn. Đừng theo kiểu cứ bắt chọn một cô rồi bắt người khác phải làm sao cho cô đó "* vượt ngọn cây"
 
Upvote 0
Tức bạn đã chọn cho mình một cách chèn ảnh, cụ thể là dưới dạng Comment. Bây giờ bạn muốn người ta uốn nó theo ý bạn là ảnh phải to ra mà vẫn giữ nguyên kích thước hàng cột?

Nếu không nhất thiết là comment thì đăng bài ở chủ đề mới, nêu rõ yêu cầu, có minh họa và xin hướng dẫn. Cách chèn thì để cho người giúp tự chọn. Đừng theo kiểu cứ bắt chọn một cô rồi bắt người khác phải làm sao cho cô đó "* vượt ngọ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
 
Upvote 0
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à: 199159
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
 
Upvote 0
Web KT
Back
Top Bottom