Giúp em sửa code chèn ảnh vào excel. (1 người xem)

[N Khánh]

Em tìm thấy bài đăng rất hay này trên diễn đàn ạ: https://www.giaiphapexcel.com/diendan/threads/chèn-hình-vào-cell-bằng-hàm-tự-tạo.51408/
Nhưng hiện tại muốn chỉnh ả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. 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]

Em tìm thấy bài đăng rất hay này trên diễn đàn ạ: https://www.giaiphapexcel.com/diendan/threads/chèn-hình-vào-cell-bằng-hàm-tự-tạo.51408/
Nhưng hiện tại muốn chỉnh ả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. 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 !!!

Nếu vẫn muốn comment, tức chỉ hiện ảnh khi đưa trỏ chuột vào cell thì thử thay

With Cel.Comment.Shape
   ...
End With

đang có bằng

With Cel.Comment.Shape
    .Left = Cel.Left
    .Top = Cel.Top
    .Width = 700
    .Height = 500
    .Fill.UserPicture Pic
End With

Hoặc sửa thành

With Cel.Comment.Shape
    .Left = Cel.Left
    .Top = Cel.Top
    .Width = Cel.Width
    .Height = Cel.Height
    .Fill.UserPicture Pic
  End With

Lúc này thao tác như sau: chọn B64 -> nhập công thức

=CommPic(BD54;B64:X84)

Khi đó comment sẽ cho ô B64 và có chiều rộng bằng chiều rộng của vùng B64:X84, còn chiều cao bằng chiều cao của vùng B64:X84. Vùng B64:X84 không cần Merge.

Đấy là tôi nghĩ thế, chưa thử
----
Thử code sau

Function CommPic(Pic As String, Cel As Range) As String
    On Error Resume Next
    
    Application.Volatile
    Cel(1).Comment.Delete
    If Cel(1).Comment Is Nothing Then Cel(1).AddComment
    Cel(1).Comment.Text vbLf
    With Cel(1).Comment.Shape
        .Width = Cel.Width
        .Height = Cel.Height
        .Fill.UserPicture Pic
    End With
End Function

 

[N Khánh]

Nếu vẫn muốn comment, tức chỉ hiện ảnh khi đưa trỏ chuột vào cell thì thử thay

With Cel.Comment.Shape
   ...
End With

đang có bằng

With Cel.Comment.Shape
    .Left = Cel.Left
    .Top = Cel.Top
    .Width = 700
    .Height = 500
    .Fill.UserPicture Pic
End With

Hoặc sửa thành

With Cel.Comment.Shape
    .Left = Cel.Left
    .Top = Cel.Top
    .Width = Cel.Width
    .Height = Cel.Height
    .Fill.UserPicture Pic
  End With

Lúc này thao tác như sau: chọn B64 -> nhập công thức

=CommPic(BD54;B64:X84)

Khi đó comment sẽ cho ô B64 và có chiều rộng bằng chiều rộng của vùng B64:X84, còn chiều cao bằng chiều cao của vùng B64:X84. Vùng B64:X84 không cần Merge.

Đấy là tôi nghĩ thế, chưa thử
----
Thử code sau

Function CommPic(Pic As String, Cel As Range) As String
    On Error Resume Next
   
    Application.Volatile
    Cel(1).Comment.Delete
    If Cel(1).Comment Is Nothing Then Cel(1).AddComment
    Cel(1).Comment.Text vbLf
    With Cel(1).Comment.Shape
        .Width = Cel.Width
        .Height = Cel.Height
        .Fill.UserPicture Pic
    End With
End Function

Vẫn không được bạn ạ, mình không muốn ảnh vào comment mà chỉ muốn chèn 1 hình theo link cố định vào vừa cái ô đó thôi, không cần merge càng tốt. Bác giúp mình với

 

[N Khánh]

Mình sửa cái width vs height để đc ảnh theo kích thước rùi, mà giờ mình chỉ muốn chèn ảnh là ảnh trực tiếp, không ở dạng comment thì làm thế nào ạ. Bác nào sửa cho mình với

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 = 270: .Height = 210
    .Fill.UserPicture Pic
  End With
End Function