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

7 Responses

1. hands says:

   23/12/2022 at 10:57 am

   Nhân tiện có bạn thắc mắc về hàm này liên quan đến Merge cell tại đây:
   https://www.giaiphapexcel.com/forum/showthread.php?52995-Tự-động-thay-đồi-hình-ảnh-theo-danh-sách-và-insert-copy-đc
   Tôi cải tiến lại hàm này như sau:

   Function CommPic(Pic As String, Cel As Range) As String
     Dim mRng As Range
     On Error Resume Next
     Application.Volatile
     Cel(1, 1).Comment.Delete
     If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
     Cel(1, 1).Comment.Text vbLf
     Set mRng = Cel(1, 1).MergeArea
     If mRng Is Nothing Then Set mRng = Cel(1, 1)
     With Cel(1, 1).Comment.Shape
       .Shadow.Visible = msoFalse '<--- Thêm vào nếu không muốn có Shadow
       .Line.Visible = msoFalse      '<--- Thêm vào nếu không muốn có đường viền
       .AutoShapeType = msoShapeRectangle  '<--- Thêm vào để che mũi tên đỏ trong cell
       .Left = mRng.Left: .Top = mRng.Top: .Visible = True
       .Width = mRng.Width: .Height = mRng.Height
       .Fill.UserPicture Pic
     End With
   End Function

   Cú pháp sử dụng vẫn như cũ

   Anh Tuan ơi ! Anh có cách nào hiển thị và in hình ảnh được luôn không ! Em chèn được mà khi in ra chẳng thấy gì hết ! Anh Giúp em với nhé ! Cám ơn anh nhiều !

   Mũi tên thì không thể làm mất, nhưng cái màu đỏ thì em cho nó biến được đấy Thầy!

   Sử dụng một trong 3 thủ tục này:

   Sub Test()
   '  Application.DisplayCommentIndicator = xlCommentIndicatorOnly
   '  Application.DisplayCommentIndicator = xlCommentAndIndicator
     Application.DisplayCommentIndicator = [B]xlNoIndicator[/B]
   End Sub

   Nhưng tốt nhất KHÔNG sử dụng, vì mất công phải set nó lại hiện trạng ban đầu.

   Anh Tuấn viết code này rất hay,nhưng em muốn anh viết thêm một lệnh để chuyển hình sang bên phía phải ô chỉ khi nào mình rê chuột thì mới nổi hình lên, như vậy mới thuận tiện trong việc quản lý nhân viên không phải kéo giản hàng ra trông xấu. thank anh

   Thêm dòng này vào hàm CommPic là được rồi:
   Application.DisplayCommentIndicator = -1

   Em thấy trong file test của anh bắt buộc phải có file hình đi kèm theo trong folder thì hình chèn trong excel mới chạy được. Vậy anh cho em hỏi có cách nào không cần file hình đi chung với file excel mà hình vẫn chèn tự động được không? vì bản báo cáo của em file gửi qua mail công ty, nếu phải kèm theo file hình nữa thì kích thước file sẽ rất nặng. Anh giúp em với ! thanks Anh.

   Vậy theo bạn thì hình từ đâu mà có?
   Có vài cách như sau:
   1> Hình được cho vào 1 folder (như bài 1)
   2> Hình được chèn thẳng vào trong 1 sheet nào đó trong file
   3> Hình được đặt trên server mạng cty
   Riêng với cách 2 thì cũng làm cho file nặng lên thêm vì dung lượng hình trong sheet và cũng không thể dùng cách này để chèn hình vào Comment
   Cách 3 cũng khả thi nếu bạn biết lưu hình lên server
   Ngoài ra, nếu máy tính của người nhận có kết nối internet, ta có thể post hình lên web (photobucket chẳng hạn) rồi chèn hình vào comment bằng link hình

   Reply
2. hands says:

   23/12/2022 at 11:00 am

   [URL="https://www.giaiphapexcel.com/forum/member.php?5605-anhtuan1066"%5DCác anh ơi. Em thấy lệnh này ứng dụng rất hay. Em muốn sử dụng cách chọn hình thứ 2 thì làm thế nào.
   Ví dụ: Em copy tất cả các hình vào sheets khác thì em phải viết lại code như thế nào.

   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?

   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é)

   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.

   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?

   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

   http://www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/post-504282

   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:

   Cel(1, 1).Comment.Visible = True

   Gửi lại file nhé

   Reply
3. hands says:

   23/12/2022 at 11:06 am

   Chào anh
   EM có đọc về hàm commpic của anh trên diễn đàn này
   Em có có tự viết hàm, nếu chạy trên window thì ok, có thể chạy được và nhấn F9 là tự fill hình vào cell, nhưng khi sang mac os thì không thể chạy được
   Anh tư vấn giùm em được không ạ
   Các module em viết như sau
   1. Hàm lấy link ảnh, ảnh ở trong thư mục tên là /hinhanh, cùng cấp với file excel.

   Function link(piclink As String) As String
   link = ThisWorkbook.Path & "hinhanh" & piclink & ".jpg"
   If piclink = "" Then link = ""
   End Function
   'DV-EIKy3eufiqTGkGTXWw9aW5 # Do not remove this line; required for DocVerse merge.

   2. Hàm chèn ảnh

   Function CommPic(Pic As String, Cel As Range) As String  Dim mRng As Range
     On Error Resume Next
     Application.Volatile
     Cel(1, 1).Comment.Delete
     If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
     Cel(1, 1).Comment.Text vbLf
     Set mRng = Cel(1, 1).MergeArea
     If mRng Is Nothing Then Set mRng = Cel(1, 1)
     With Cel(1, 1).Comment.Shape
       .Shadow.Visible = msoFalse
       .Line.Visible = msoFalse
       .AutoShapeType = msoShapeRectangle
       .Left = mRng.Left: .Top = mRng.Top: .Visible = True
       .Width = mRng.Width: .Height = mRng.Height
       .Fill.UserPicture Pic
     End With
   End Function
   'DV-Co5ZXVcg3s3yA29Wn227Ia # Do not remove this line; required for DocVerse merge.

   3. Hàm xoá ảnh (khi thay đổi tên hình ảnh sẽ tự động xoá ảnh cũ đi để điền ảnh mới)

   Option ExplicitFunction Xoaanh(anh As String, Cel As Range) As String
   On Error Resume Next
   Application.Volatile
   If anh = "" Then Cel(1, 1).Comment.Delete
   End Function
   
   'DV-v8fKYPi6NLdl401SuhYrFJ # Do not remove this line; required for DocVerse merge.

   Sau đó em viết vào file excel như sau

   =IF(A15<>"",CommPic(link(B15),D15),Xoaanh(B15,D15))

   Nếu như trong window hoạt động tốt thì trong mac os không hoạt động được anh à
   Mong anh tư vấn giùm em

   Bạn hỏi thế sao mà biết trả lời đây? Tôi có xài MAC đâu chứ
   (mà chắc cũng hiếm người xài)

   Chào anh
   Em đã nghiên cứu và làm được
   Chỉ cần thay thế link = ThisWorkbook.Path & "hinhanh" & piclink & ".jpg"
   thay dấu bằng dấu : là được ạ

   Xin hỏi các bạn, khi ta sử dụng hàm để chèn ảnh vào comment ,khí có ảnh thì vô tư rồi . Nhưng khi trường hợp có tên, nhưng không có ảnh thì nó chỉ cho khung comment trống . Vậy bổ xung code thế nào để nó tự xóa các comment không có ảnh ?

   Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:

   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) = "https://" 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 = "https://" & 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

   http://www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/post-678387

   
   qua thời gian xử dụng em thấy có vài điều thế này, mong thầy xem xét, nếu được thì update cho bản sau he thầy.
   thêm mắm muối thế nào để tự động nhận luôn đuôi mở rộng của tấm hình thầy
   ví dụ tấm hình 1 tên 1.jpg
   tấm hình 2 tên 2.png
   hàm sẽ tự động tìm tại đường dẫn đó file tên như vậy và có đuôi mở rộng thỏa thì hiện tấm ảnh đó lên
   và thầy có thể bổ xung thêm cho hàm nó mặc định đường dẫn là chung với file excel hiện hành (nếu file có sẵn) luôn được không thầy, nếu là file excel mới tạo (trường hợp hàm trên ở trong add ins) thì đường dẫn mặc đinh là C:UsersPublicPictures
   em xin ví dụ nếu là file có sẵn đường dẫn E: (code trên là addins) thì tại:
   ô A1 là 1
   ô A2 là D:Anh1
   tương ứng ô B1, B2 sẽ là =commpic(RC)
   thì tại ô B1 sẽ xuất tấm hình tại đường dẫn E:1.* (* sẽ là đuôi mở rộng, nếu có tấm hình nào tên là 1 – giả sử có 2 file 1.jpg 1.png thì ưu tiên 1.jpg trước)
   tại ô B2 thì sẽ là tấm ảnh 1.* tại đường dẫn đó (* tương tự như trên)-cái này thì hàm trên làm được rồi
   còn nếu là file mới tạo chưa lưu thì tại ô B1 sẽ lấy đường dẫn C:Users……..Picture file ảnh là 1.* (* tương tự như trên)
   nếu em có diễn giải hơi loằng ngoằng thì thầy thông cảm bỏ quá cho em
   thầy có thể cho nó tự update luôn hay không, chứ mỗi lần thay đổi lại nhấn F9
   ————————–
   em xem lại thì thấy "ActiveWorkbook.Path" vậy 1 vấn đề đã giải quyết. còn vụ đuôi mở rộng
   ————————–
   hên là đọc code thầy viết còn hiểu
   ngồi 1 tí là ra

   If Left(PicPath, 7) = "https://" Then
       bChk = URLExists(PicPath)
     Else
   
   [COLOR=#ff0000]Tam = PicPath
     Dim FormatPic
     FormatPic = Array(".JPG", ".JPE", ".GIF", ".PNG", ".BMP")
     For i = 0 To UBound(FormatPic)
       bChk = fso.FileExists(PicPath)
       If bChk = False Then
         PicPath = ThisWorkbook.Path & "" & Tam & FormatPic(i)
         bChk = fso.FileExists(PicPath)
         If bChk Then GoTo Nex
       End If
       Next i
   
   If bChk = False Then
     For i = 0 To UBound(FormatPic)
       bChk = fso.FileExists(PicPath)
       If bChk = False Then
           PicPath = "C:Users" & Environ("Username") & "Pictures" & Tam & FormatPic(i)
         bChk = fso.FileExists(PicPath)
         If bChk Then GoTo Nex
       End If
       Next i
   End If
   
   Nex:[/COLOR]
   
   End If
     If bChk Then

   vấn đề định dạng ảnh và đường dẫn C:Users……..Picture đã được giải quyết

   Em tải về fille ComPic nhưng tại sao khi em print preview thì lại không thấy ảnh

   [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

   vậy thầy chỉ em đoạn code lấy thông tin của file được chọn yk thầy. em tự sửa lại.
   trước em tìm được đoạn code fso lấy toàn bộ thông tin của mọi tệp tin (nếu có) mà giờ lạc đâu mất rồi. nên không biết code lấy size ảnh (đối với trường hợp này) để chỉnh lại.

   Thử hàm này xem:

   Function PicDimensions(ByVal FileName As String)
     On Error Resume Next
     Dim sName As String, sFolder As String
     Dim FSO As Object, oShel As Object
     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set oShel = CreateObject("Shell.Application")
     If FSO.FileExists(FileName) Then
       sFolder = FSO.GetFile(FileName).ParentFolder.Path
       sName = FSO.GetFile(FileName).Name
       With oShel.Namespace("" & sFolder & "")
         PicDimensions = .Getdetailsof(.ParseName("" & sName & ""), 31)
       End With
     End If
   End Function

   Code lấy kích thước của file hình

   Chào Thầy ndu và các A/E GPE

   Sau khi xem các bài hướng dẫn trên em đã chèn được hình vào ô excel. Em muốn tạo thêm 01 sheet (hoặc 1 file excel khác) chỉ chứa nội dung thôi (hình ảnh nằm trong cell – không còn công thức nữa). Em đã thử copy và paste value, comment, formats, tuy nhiên hình ảnh không còn nằm trong cell nữa.

   Rất mong nhận được hướng dẫn của thầy và mọi người

   Em cảm ơn

   vậy bạn chưa hiểu cách hoạt động của nó rồi.
   cách thức hoạt động của hàm là chèn chú thích comment vào nên bạn copy kiểu gì cũng chả theo được đâu
   nếu sau khi bạn chèn ảnh xong rồi mà muốn giữ nguyên ảnh đó thì sau khi chèn xong bạn xóa công thức tại ô đó đi. lưu ý không xóa luôn ô chứa công thức nha, chỉ xóa công thức thôi, còn nếu bạn muốn vẫn còn công thức mà hình ảnh không mất thì có thể đặt điều kiện theo kiểu =if(true, chèn hình, không làm gì)
   thích thì dùng code sau, tôi đã sửa vài chỗ để phù hợp với tôi thôi, bạn thích thì dùng, không thì cứ dùng code của thầy ndu

   Dạ cám ơn Anh langtuchungtinh360

   Em đã giải quyết được vấn đề của em rồi ạ. Anh có thể hướng dẫn giúp em cách sử dụng hàm commpic của anh viết được không ạ. em vẫn sử dụng theo cách cũ là = commpic("đường dẫn tới file ảnh"&""&ô chứa tên ảnh&".JPG"). Phần định dạng ảnh .JPG……em vẫn nhập thủ công, em thấy trong code của anh đã giải quyết vấn đề này nhưng em không biết cách vận dụng.

   Mong anh hướng dẫn. Cám ơn Anh

   tại code đó tôi lười không nhớ hết được các định dạng ảnh nên để cho nó tự xử ấy mà.
   +cụ thể là nếu bạn nhập đường dẫn cụ thể thì code sẽ lấy đường dẫn đó
   +còn nếu định dạng file không đúng (không chèn được) thì sẽ sửa lại cho đúng rồi chèn vào.
   + code cũng kiểm tra đường dẫn bạn nhập có đúng không, nếu không tồn tại thì code sẽ kiểm tra trong thư mục Picture tại ổ C, nếu có file tên như thế thì sẽ chèn vào. không thì thôi không chèn
   +vùng chèn ảnh không bắt buộc phải gộp lại tức là có thể chèn tại các ô rời rạc, chỉ cần chọn vùng là được
   +đôi khi kích thước ảnh không phù hợp với tỷ lệ vùng chèn thì code cũng xử lý để chèn vào vừa đủ phạm vi bạn chèn vì vậy ảnh sẽ không bị sai kích thước, méo mó.
   cách sử dụng thì cũng giống như cách gốc thôi, có điều chèn ảnh từ internet không được thôi (vì tôi không cần như thế)
   sửa lại hàm của anh ndu và langtuchungtinh360 lại một chút
   chèn ảnh thật vô luôn chứ không bằng ghi chú nữa (đỡ nhọc công vô chỉnh trong PageSetup để in)
   hàm bỏ chức năng chèn ảnh theo link trên mạng

   – Tại 1 cell nào đó, bạn gõ hàm =InsertPic("đường dẫn đến hình) —> ra 1 tấm hình
   – Xong bạn chọn tấm hình vừa chèn, đổi tên nó
   – Chọn vào cell chứa hàm InsertPic rồi F2 và Enter —> Ra thêm tấm hình nữa
   – vân… vân…
   Đâu phải tôi không biết cách chèn hình thật và cũng đâu phải ngẫu nhiên tôi lại chọn giải pháp là chèn hình vào comment

   em thấy cách chèn hình bằng comment cũng hay nhưng khi in ra lại phải chỉnh trong cài đặt mới in ra được, vừa rồi em vừa dính vấn đề đó. Ctrl P in ra bình thường, nhưng khi chạy code để in thì in không thấy ảnh. vì thế mới sửa lại bằng cách chèn ảnh vào luôn. cụ thể tại bài này [URL='https://www.giaiphapexcel.com/diendan/threads/c%C3%A1c-c%C3%A2u-h%E1%BB%8Fi-v%E1%BB%81-%C4%91%E1%BB%8Bnh-d%E1%BA%A1ng-in-%E1%BA%A5n-b%E1%BA%A3ng-t%C3%ADnh-%C4%91%E1%BB%81-ngh%E1%BB%8B-post-t%E1%BA%A1i-%C4%91%C3%A2y.31479/page-7#post-802684'%5D#137

   Việc chỉnh Page Setup là chuyện mà người ngồi trên máy tính phải biết (in cái gì, in từ đâu đến đâu…)
   Đặt trường hợp bạn định viết code để dành cho người không biết gì có thể dùng được mà không cần tinh chỉnh gì cả, bạn có thể viết 1 code làm công việc Page Setup kia là xong. Code có thể nằm trong sub AutOpen hoặc đặt trong sự kiện Workbook_BeforePrint, chẳng hạn:

   Private Sub Workbook_BeforePrint(Cancel As Boolean)
     Dim wks As Worksheet
     Set wks = ActiveSheet
     wks.PageSetup.PrintComments = xlPrintInPlace
   End Sub

   Nói chung là tôi không gặp bất cứ vấn đề gì trong việc in ấn với comment cả (kể cả in bằng tay hay dùng code)

   vẫn không được anh ạ.
   em đã dùng code để chọn danh sách sheet cần in
   xong trước những dòng code để in đã cho code này vào

   Dim wks As Worksheet
     Set wks = ActiveSheet
     wks.PageSetup.PrintComments = xlPrintInPlace

   còn thêm dòng này nữa

   Application.DisplayCommentIndicator = xlCommentAndIndicator

   in ra vẫn không hiện comment

   Code trên chỉ là gợi ý setup cho 1SHEET! Nếu in NHIỀU SHEET thì phải… LÀM SAO?

   Arr = array("Sheet1","Sheet2","Sheet3","Sheet4")
   Sheets(Arr).select
   Set wks = ActiveSheet

   rồi em dùng lệnh in. nhưng vẫn không in ra được comment
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

   Trời đất ơi! Không phải bạn chứ?
   Thấy bạn làm mấy file hoành tráng quá trời nên tôi không nghĩ ra lý do tại sao tình huống này có thể làm khó bạn được nhỉ?
   Tôi đã nói rõ ràng:

   Vậy thì bạn phải nghĩ đến For… Next gì đó chứ!

   Dim arr, sh As Object
     arr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
     Sheets(arr).Select
     For Each sh In ActiveWindow.SelectedSheets
       sh.PageSetup.PrintComments = xlPrintInPlace
     Next

   việc chỉnh để in được comment thì em đã chỉnh trước đó rồi, vào pagesetup vẫn thấy cài đặt in ghi chú như hiển thị, sau khi in vào lại pagesetup thì vẫn còn ở chế độ in ghi chú. nhưng trớ trêu thay khi in thì lại không thấy.
   thầy qua trang [URL='https://www.giaiphapexcel.com/diendan/threads/c%C3%A1c-c%C3%A2u-h%E1%BB%8Fi-v%E1%BB%81-%C4%91%E1%BB%8Bnh-d%E1%BA%A1ng-in-%E1%BA%A5n-b%E1%BA%A3ng-t%C3%ADnh-%C4%91%E1%BB%81-ngh%E1%BB%8B-post-t%E1%BA%A1i-%C4%91%C3%A2y.31479/page-7#post-802684'%5Dnày trả lời giúp em, chứ nói nãy giờ có vẻ đi xa chủ đề này mất rồi
   em có viết gì đâu mà hoành tráng đâu thầy. mới tập tọe à.
   vậy còn

   Sheets(arr).Select
   'xong rồi dùng lệnh in 
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
   'hoặc xuất PDF: Save As PDF
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=str_Path & TenFile

   ngoài cách trên thì có cách nào tốt hơn để in 1 loạt danh sách sheet không thầy.
   code trên là em ghi macro lại nên có vẻ chậm.
   em thấy xuất PDF hình như có cách khác với Save As thành PDF thì phải

   Chết ngắt luôn! Bạn đã viết code thành 1 dự án lớn hẳn rồi. Xem code trong hình chụp thì thấy rằng phải sửa rất nhiều chỗ mới xong (bởi bạn áp code của tôi vào thấy.. trật lất)
   ———————-
   Cũng vì code của bạn đã trở thành DỰ ÁN LỚN nên mọi người đều rất ngại khi phải xem và sửa. Vì vậy, bạn "bí" chỗ nào, hỏi chỗ đó và chỉ nên đưa file + code vừa đủ (chứ đưa 1 "rừng" thế kia, không ai trả lời là đúng rồi)

   để em xem lại. có thể sai chỗ nào đó

   Sub Test()
   Dim Arr As Variant
   Arr = Array("BB_MTN", "TAB_SDD")
   Sheets(Arr).Select
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:A.pdf"
   End Sub

   Thế này thì lại có ảnh
   Ẹc…. Ẹc….

   Reply
4. hands says:

   23/12/2022 at 11:14 am

   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 đỡ

   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

   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

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

   thành

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

   Sửa

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

   thành

   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

   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

   http://www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/post-861899

   Reply
5. hands says:

   23/12/2022 at 11:15 am

   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

   http://www.giaiphapexcel.com/diendan/threads/%C4%90%C6%B0a-%E1%BA%A3nh-hi%E1%BB%87n-v%C3%A0o-khung-textbox-b%E1%BA%B1ng-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.

   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.

   http://www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/post-863253

   Reply
6. hands says:

   23/12/2022 at 11:17 am

   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)

   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

   =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.

   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ụ:

   =CommPic("https://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.
   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

   http://www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/post-872654

   Reply
7. hands says:

   23/12/2022 at 11:20 am

   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.

   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"

   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à: [URL='www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/post-861899']199 và [URL='www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/post-803141']159
   2. Chèn hình vào comment của chủ topic: [URL='www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/#post-325030']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é:

   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 https://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

   Không nhầm thì khi in bạn phải cài đặt lại 1 chút
   1028

   Reply