Quản lý ảnh bằng Comment Cell - Cố định kích thước khi hiển thị Format Comment/ size =>height/Width

[Ngocminh19]

Em chào anh chị trên GPE
Em không biết về VBA,Em có tìm hiểu về quản lý thêm ảnh vào Comment Cell áp dụng vào file của em.
Em đang gặp vấn đề mong anh chị giúp đỡ.
Link em tìm hiểu : https://blog.hocexcel.online/chen-anh-vao-comment-bang-vba-cuc-hay.html
1.Khi thêm được ảnh vào Comment thì khi xem ảnh,hiển thị rất bé.Muốn to thì em lại phải vào định dạng chọn chiều cao,rộng lại ạ( Như em chỉnh chỉ cần cố định 1 chiều cao là xem được ạ)
2. Hiện code này chỉ áp dụng thêm từng ảnh 1 tại sheet tùy chọn ,người dùng tự chọn tên ảnh => Anh chị giúp em có thể thêm hàng loạt với điều kiện ảnh đã được lưu tên cùng với mã cần thêm ảnh vào comment cell với ạ
Anh chị giúp em với ạ. => Ưu tiên yêu cầu 1
Em cảm ơn!
Do file ảnh nặng em để vào link này ạ : https://fastupload.io/en/vNS9mNb0NhjGoN4/file

 

[Cuongneu1993]

VD dòng 27 CODE: 0404-001951, bạn tạo thư mục "Files" cạnh file Excel, đặt tên ảnh là "0404-001951.PNG" rôì bỏ ảnh vào thư mục đó
Bạn tạo cái sub khác để mở ảnh, thay đổi
ImgFile = myFile.SelectedItems(1)
thành
ImgFile = ThisWorkbook.Path & "\" & "Files" & "\" ActiveCell.Value

 

[cantl]

Anh chị giúp em với ạ. => Ưu tiên yêu cầu 1

Trên nền code hiện có, ngoáy tí cho yêu cầu 1. Yêu cầu 2 thì đang bí. há há há.
Muốn ảnh to nhỏ thì cứ tìm số 500 anh em mà sửa.

Sub AddImage()
    Dim myFile As FileDialog, ImgFile, myImg, myImgW, myImgH As Variant, ZoomF As Variant
    Dim omyImg As Object
    On Error Resume Next
    Set myFile = Application.FileDialog(msoFileDialogOpen)
        With myFile
        .Title = "Choose File"
        .AllowMultiSelect = False
        .Filters.Add Description:="Images", Extensions:="*.jpg,*.Jpg,*.gif,*.png,*.tif,*.bmp", Position:=1
        If .Show <> -1 Then
            MsgBox "No image selected", vbCritical
            Exit Sub
        End If
    End With
    ImgFile = myFile.SelectedItems(1)
    Application.ScreenUpdating = False
    With ActiveCell
        .ClearComments
        .AddComment
    End With
    Set omyImg = CreateObject("WIA.ImageFile")
    omyImg.LoadFile ImgFile
    myImgW = omyImg.Width
    myImgH = omyImg.Height
    ZoomF = 500 / myImgW
    With ActiveCell.Comment
        .Shape.Fill.UserPicture ImgFile
        .Shape.Width = myImgW * ZoomF
        .Shape.Height = myImgH * ZoomF
    End With
    Application.ScreenUpdating = True
    Set myFile = Nothing: Set myImg = Nothing
End Sub

 

[htin1997]

thêm ảnh vào Comment Cell

Anh dùng hàm này nha, hàm này nguồn từ GPE, em không nhớ bài gốc ở đâu, cảm ơn tác giả lần nữa nhé.
Tham số hàm:
- pic: Đường dẫn ảnh (có thể là local hoặc web)
- Cel: Ô cần đặt comment
- vis: Show/hide comment
• Có thể sửa cở ảnh, anh cần thì truyền thêm tham số vào hàm rồi lấy giá trị trên sheet để tùy chọn size cho từng ảnh, nếu mặc định thì cứ sửa trong code nha.

Function T_CommPic(pic As String, Cel As Range, vis As Boolean) As String
'Ham chen comment thanh anh(Pic)
  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
  With Cel(1, 1).Comment.Shape
    .Left = Cel.Left: .Top = Cel.Top:
    .Visible = vis
    '.Width = Cel.Width: .Height = Cel.Height
    .Width = 150: .Height = 200 'sửa kích thước ảnh ở đây'
    .Fill.UserPicture pic
  End With
End Function