Cần giúp: Chèn tự động ảnh vào comment trên excel

iamcuong · 15/11/18

Thân gửi: Các Chú, các anh chị em trong diễn đàn.
Hiện em đang có 1 file excel có 1000 mã hàng, 1 folder có 1000 ảnh tương ứng với 1000 mã hàng (Tên sản phẩm đặt theo tên mã hàng)

- Em muốn thực hiện thao tác chèn ảnh vào comment hàng loạt như hướng dẫn sau thì liệu có phương án nào khả thi không ạ?
- Nếu không có PA nào khả thi thì các Chú, các anh chị em cho em xin link bài viết VBA về chèn ảnh tự động hàng loạt vào 1 CELL cũng được ạ.

Cám ơn các chú, các anh chị nhiều ạ.
==

Add Picture to Comment

Right-click the cell which contains the comment.
Choose Show/Hide Comments, and clear any text from the comment.
Click on the border of the comment, to select it.
Choose Format|Comment
On the Colors and Lines tab, click the drop-down arrow for Color.
Click Fill Effects
On the picture tab, click Select Picture
Locate and select the picture
To keep the picture in proportion, add a check mark to Lock Picture Aspect Ratio
Click Insert, click OK, click OK

==

saobekhonglac · 15/11/18

iamcuong đã viết:
Thân gửi: Các Chú, các anh chị em trong diễn đàn.
Hiện em đang có 1 file excel có 1000 mã hàng, 1 folder có 1000 ảnh tương ứng với 1000 mã hàng (Tên sản phẩm đặt theo tên mã hàng)

- Em muốn thực hiện thao tác chèn ảnh vào comment hàng loạt như hướng dẫn sau thì liệu có phương án nào khả thi không ạ?
- Nếu không có PA nào khả thi thì các Chú, các anh chị em cho em xin link bài viết VBA về chèn ảnh tự động hàng loạt vào 1 CELL cũng được ạ.

Cám ơn các chú, các anh chị nhiều ạ.
==

Add Picture to Comment

Right-click the cell which contains the comment.

Choose Show/Hide Comments, and clear any text from the comment.

Click on the border of the comment, to select it.

Choose Format|Comment

On the Colors and Lines tab, click the drop-down arrow for Color.

Click Fill Effects

On the picture tab, click Select Picture

Locate and select the picture

To keep the picture in proportion, add a check mark to Lock Picture Aspect Ratio

Click Insert, click OK, click OK

==

Có thể dùng chắc năng Hyperlink, khi nhấp vào mã nào thì nó sẽ hiện lên hình của mã đó (tên hình file trùng với tên mã). Cách này thì không cần chèn hình chiếm diện tích cũng như năng file.
Nếu cần chèn hình để dễ quản lý hay sử dụng cho các mục đích khác thì chờ VBA hỗ trợ

iamcuong · 15/11/18

saobekhonglac đã viết:
Có thể dùng chắc năng Hyperlink, khi nhấp vào mã nào thì nó sẽ hiện lên hình của mã đó (tên hình file trùng với tên mã). Cách này thì không cần chèn hình chiếm diện tích cũng như năng file.
Nếu cần chèn hình để dễ quản lý hay sử dụng cho các mục đích khác thì chờ VBA hỗ trợ

Dạ em muốn đóng gói thành 1 file để gửi cho KH luôn. Vụ chèn hyperlink này em cũng đã nghĩ tới, mà có vẻ hơi bất tiện cho KH ạ.

saobekhonglac · 15/11/18

iamcuong đã viết:
Dạ em muốn đóng gói thành 1 file để gửi cho KH luôn. Vụ chèn hyperlink này em cũng đã nghĩ tới, mà có vẻ hơi bất tiện cho KH ạ.

Đúng rồi, Hyperlink thì chỉ làm để mình theo dõi, chứ còn gửi Khách thì không tiện, bạn chờ các Anh rành về VBA giúp nhé.

Nguyễn Hồng Quang · 15/11/18

iamcuong đã viết:
Dạ em muốn đóng gói thành 1 file để gửi cho KH luôn. Vụ chèn hyperlink này em cũng đã nghĩ tới, mà có vẻ hơi bất tiện cho KH ạ.

Nghiên cứu ở đây xem sao bạn ơi
https://stackoverflow.com/questions/21396983/add-image-as-comment-vba

saobekhonglac · 15/11/18

iamcuong đã viết:
Dạ em muốn đóng gói thành 1 file để gửi cho KH luôn. Vụ chèn hyperlink này em cũng đã nghĩ tới, mà có vẻ hơi bất tiện cho KH ạ.

Bạn thử code bên dưới sau xem có giúp được bạn không.

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    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)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

chiendich · 15/11/18

iamcuong đã viết:
Thân gửi: Các Chú, các anh chị em trong diễn đàn.
Hiện em đang có 1 file excel có 1000 mã hàng, 1 folder có 1000 ảnh tương ứng với 1000 mã hàng (Tên sản phẩm đặt theo tên mã hàng)

- Em muốn thực hiện thao tác chèn ảnh vào comment hàng loạt như hướng dẫn sau thì liệu có phương án nào khả thi không ạ?
- Nếu không có PA nào khả thi thì các Chú, các anh chị em cho em xin link bài viết VBA về chèn ảnh tự động hàng loạt vào 1 CELL cũng được ạ.

Cám ơn các chú, các anh chị nhiều ạ.
==

Add Picture to Comment

Right-click the cell which contains the comment.

Choose Show/Hide Comments, and clear any text from the comment.

Click on the border of the comment, to select it.

Choose Format|Comment

On the Colors and Lines tab, click the drop-down arrow for Color.

Click Fill Effects

On the picture tab, click Select Picture

Locate and select the picture

To keep the picture in proportion, add a check mark to Lock Picture Aspect Ratio

Click Insert, click OK, click OK

==

ứng dụng code này xem.
Sub CommentImages()

repertoire = ThisWorkbook.Path & "\"

echelle = 0.7

For Each c In Range("A2", [A65000].End(xlUp))

c.ClearComments

c.AddComment

c.Comment.Text Text:=CStr(c)

fichier = CStr(c.Value) & ".jpg"

If Dir(repertoire & fichier) <> "" Then

c.Comment.Shape.Fill.UserPicture repertoire & fichier

taille = TaillePixelsImage(repertoire, fichier)

c.Comment.Shape.Height = Val(Split(taille, "x")(1))

c.Comment.Shape.Width = Val(Split(taille, "x")(0))

c.Comment.Shape.ScaleHeight echelle, msoFalse, msoScaleFromTopLeft

c.Comment.Shape.ScaleWidth echelle, msoFalse, msoScaleFromTopLeft

End If

Next

End Sub

Function TaillePixelsImage(repertoire, fichier)

Set myShell = CreateObject("Shell.Application")

Set myFolder = myShell.Namespace(repertoire)

Set myFile = myFolder.Items.Item(fichier)

TaillePixelsImage = myFolder.GetDetailsOf(myFile, 26)

End Function

iamcuong · 15/11/18

Mục đích của em là làm được như ảnh ạ.

Dữ liệu khoảng 2000 dòng ạ.

Bài đã được tự động gộp: 15/11/18

chiendich đã viết:
ứng dụng code này xem.
Đoạn của anh em chạy thì nó chỉ sinh ra comment, chứ chưa chèn được ảnh vào ạ.

ndu96081631 · 15/11/18

iamcuong đã viết:
Mục đích của em là làm được như ảnh ạ.
View attachment 207714
Dữ liệu khoảng 2000 dòng ạ.

Bài đã được tự động gộp: 15/11/18

Ngắn gọn vầy đi:

Mã:

Private Sub Image2Comment(ByVal PicPath As String, ByVal PicCel As Range)
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  PicCel.Comment.Delete
  If fso.FileExists(PicPath) Then
    On Error GoTo 0
    PicCel.AddComment vbLf
    PicCel.Comment.Shape.Fill.UserPicture PicPath
  End If
End Sub
Sub Main()
  Dim PicPath As String, cel As Range
  PicPath = ThisWorkbook.Path & "\"
  For Each cel In Range("A2:A2000")
    Image2Comment PicPath & cel.Text & ".png", cel
  Next
End Sub

saobekhonglac · 16/11/18

iamcuong đã viết:
Mục đích của em là làm được như ảnh ạ.
View attachment 207714
Dữ liệu khoảng 2000 dòng ạ.

Bài đã được tự động gộp: 15/11/18

Thế có nhấp vô xem ảnh được không.

Emyeuexcel · 22/5/20

ndu96081631 đã viết:

Ngắn gọn vầy đi:

Mã:

Private Sub Image2Comment(ByVal PicPath As String, ByVal PicCel As Range)
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  PicCel.Comment.Delete
  If fso.FileExists(PicPath) Then
    On Error GoTo 0
    PicCel.AddComment vbLf
    PicCel.Comment.Shape.Fill.UserPicture PicPath
  End If
End Sub
Sub Main()
  Dim PicPath As String, cel As Range
  PicPath = ThisWorkbook.Path & "\"
  For Each cel In Range("A2:A2000")
    Image2Comment PicPath & cel.Text & ".png", cel
  Next
End Sub

Em chào thầy ah!
Thầy cho em hỏi nếu mình vừa có hình đuôi JPG và PNG thì code này phải thêm thế nào để sử dụng được cả 2 đuôi hình ạ?
Em cảm ơn thầy chỉ dạy!

hungmo · 16/6/20

Emyeuexcel đã viết:
Em chào thầy ah!
Thầy cho em hỏi nếu mình vừa có hình đuôi JPG và PNG thì code này phải thêm thế nào để sử dụng được cả 2 đuôi hình ạ?
Em cảm ơn thầy chỉ dạy!

Bạn đổi đuôi .png thành .jpg hoặc .jpeg trong code là xong nhé !

HeSanbi · 16/6/20

Đọc qua bài viết tôi thấy code thêm Ảnh vào chú thích ô quá thiếu sót nên tôi thêm phần code dưới đây để mọi người tham khảo thêm

---------------------------
Sử dụng:
Call SetImageForComment ("C:\a.png", Range("A1"), 200)

---------------------------

PHP:

Public Function SetImageForComment(filePath As String, Target As Range, Optional SetWidth As Single = 200) As Boolean
  On Error Resume Next
  Dim CommentBox As Comment, Width As Single, Height As Single
  With VBA.CreateObject("WIA.ImageFile"): .LoadFile filePath: Width = .Width: Height = .Height: End With
  If Width = 0 Or Height = 0 Then
'    With New ImageDimensions
'      .ImageFullPath = filePath
'      Width = .PixelWidth: Height = .PixelHeight
'    End With
  End If
  If Width = 0 Or Height = 0 Then Exit Function
  Set Target = Target.Parent.Range(Target.Address)
  Target.ClearComments
  Set CommentBox = Target(1, 1).AddComment
  With CommentBox
    .Text Text:=""
    .Shape.Fill.UserPicture (filePath)
    .Shape.Width = SetWidth
    .Shape.Height = ((SetWidth / Width) * Height)
  End With
  On Error GoTo 0
  SetImageForComment = True
End Function

-----------------

Tạo Class Module có tên: ImageDimensions nếu không tồn tại thư viện WIA.ImageFile:
-----------------

PHP:

Option Explicit

Private pPixelWidth As Long
Private pPixelHeight As Long
Private pImageFullPath As String

Public Property Get ImageFullPath() As String
  ImageFullPath = pImageFullPath
End Property
Public Property Let ImageFullPath(fullPath As String)
  pImageFullPath = fullPath
  Dim dimensionsText As String

  dimensionsText = GetImageDimensions(fullPath)
  pPixelWidth = LEFT$(dimensionsText, InStr(dimensionsText, ",") - 1)
  pPixelHeight = Mid$(dimensionsText, InStr(dimensionsText, ",") + 1)
End Property

Public Property Get PixelWidth() As Long
  PixelWidth = pPixelWidth
End Property
Private Property Let PixelWidth(value As Long)
  pPixelWidth = value
End Property

Public Property Get PixelHeight() As Long
  PixelHeight = pPixelHeight
End Property
Private Property Let PixelHeight(value As Long)
  pPixelHeight = value
End Property

Private Function GetImageDimensions(ByVal fullPath As String)
  Dim fileName As String
  Dim fileFolder As String
  fileName = FilenameFromPath(fullPath)
  fileFolder = FolderFromFilePath(fullPath)

  Dim objShell As Object
  Set objShell = CreateObject("Shell.Application")

  Dim targetFolder As Object
  Set targetFolder = objShell.Namespace(fileFolder & vbNullString)

  Const IMAGE_DIMENSIONS As Long = 31
  Dim dimensionsPrep As String
  dimensionsPrep = targetFolder.GetDetailsOf( _
    targetFolder.Items.Item(fileName & vbNullString), _
    IMAGE_DIMENSIONS)

  dimensionsPrep = Replace(dimensionsPrep, " x ", ",")
  dimensionsPrep = Mid$(dimensionsPrep, 2, Len(dimensionsPrep) - 2)
  GetImageDimensions = dimensionsPrep
End Function

Private Function FolderFromFilePath(ByVal filePath As String) As String
  Dim filesystem As Object
  Set filesystem = CreateObject("Scripting.FileSystemObject")
  FolderFromFilePath = filesystem.GetParentFolderName(filePath) & Application.PathSeparator
End Function

Private Function FilenameFromPath(ByVal filePathAndName As String) As String
  Dim pathLength As Long
  Dim iString As String
  pathLength = Len(filePathAndName)
  iString = vbNullString

  Dim iCount As Long
  For iCount = pathLength To 1 Step -1
    If Mid$(filePathAndName, iCount, 1) = Application.PathSeparator Then
      FilenameFromPath = iString: Exit Function
    End If
    iString = Mid$(filePathAndName, iCount, 1) & iString
  Next iCount
  FilenameFromPath = filePathAndName
End Function

phamvucattien · 21/7/20

HeSanbi đã viết:

Đọc qua bài viết tôi thấy code thêm Ảnh vào chú thích ô quá thiếu sót nên tôi thêm phần code dưới đây để mọi người tham khảo thêm

---------------------------
Sử dụng:
Call SetImageForComment ("C:\a.png", Range("A1"), 200)

---------------------------

PHP:

Public Function SetImageForComment(filePath As String, Target As Range, Optional SetWidth As Single = 200) As Boolean
  On Error Resume Next
  Dim CommentBox As Comment, Width As Single, Height As Single
  With VBA.CreateObject("WIA.ImageFile"): .LoadFile filePath: Width = .Width: Height = .Height: End With
  If Width = 0 Or Height = 0 Then
'    With New ImageDimensions
'      .ImageFullPath = filePath
'      Width = .PixelWidth: Height = .PixelHeight
'    End With
  End If
  If Width = 0 Or Height = 0 Then Exit Function
  Set Target = Target.Parent.Range(Target.Address)
  Target.ClearComments
  Set CommentBox = Target(1, 1).AddComment
  With CommentBox
    .Text Text:=""
    .Shape.Fill.UserPicture (filePath)
    .Shape.Width = SetWidth
    .Shape.Height = ((SetWidth / Width) * Height)
  End With
  On Error GoTo 0
  SetImageForComment = True
End Function

-----------------

Tạo Class Module có tên: ImageDimensions nếu không tồn tại thư viện WIA.ImageFile:
-----------------

PHP:

Option Explicit

Private pPixelWidth As Long
Private pPixelHeight As Long
Private pImageFullPath As String

Public Property Get ImageFullPath() As String
  ImageFullPath = pImageFullPath
End Property
Public Property Let ImageFullPath(fullPath As String)
  pImageFullPath = fullPath
  Dim dimensionsText As String

  dimensionsText = GetImageDimensions(fullPath)
  pPixelWidth = LEFT$(dimensionsText, InStr(dimensionsText, ",") - 1)
  pPixelHeight = Mid$(dimensionsText, InStr(dimensionsText, ",") + 1)
End Property

Public Property Get PixelWidth() As Long
  PixelWidth = pPixelWidth
End Property
Private Property Let PixelWidth(value As Long)
  pPixelWidth = value
End Property

Public Property Get PixelHeight() As Long
  PixelHeight = pPixelHeight
End Property
Private Property Let PixelHeight(value As Long)
  pPixelHeight = value
End Property

Private Function GetImageDimensions(ByVal fullPath As String)
  Dim fileName As String
  Dim fileFolder As String
  fileName = FilenameFromPath(fullPath)
  fileFolder = FolderFromFilePath(fullPath)

  Dim objShell As Object
  Set objShell = CreateObject("Shell.Application")

  Dim targetFolder As Object
  Set targetFolder = objShell.Namespace(fileFolder & vbNullString)

  Const IMAGE_DIMENSIONS As Long = 31
  Dim dimensionsPrep As String
  dimensionsPrep = targetFolder.GetDetailsOf( _
    targetFolder.Items.Item(fileName & vbNullString), _
    IMAGE_DIMENSIONS)

  dimensionsPrep = Replace(dimensionsPrep, " x ", ",")
  dimensionsPrep = Mid$(dimensionsPrep, 2, Len(dimensionsPrep) - 2)
  GetImageDimensions = dimensionsPrep
End Function

Private Function FolderFromFilePath(ByVal filePath As String) As String
  Dim filesystem As Object
  Set filesystem = CreateObject("Scripting.FileSystemObject")
  FolderFromFilePath = filesystem.GetParentFolderName(filePath) & Application.PathSeparator
End Function

Private Function FilenameFromPath(ByVal filePathAndName As String) As String
  Dim pathLength As Long
  Dim iString As String
  pathLength = Len(filePathAndName)
  iString = vbNullString

  Dim iCount As Long
  For iCount = pathLength To 1 Step -1
    If Mid$(filePathAndName, iCount, 1) = Application.PathSeparator Then
      FilenameFromPath = iString: Exit Function
    End If
    iString = Mid$(filePathAndName, iCount, 1) & iString
  Next iCount
  FilenameFromPath = filePathAndName
End Function

anh có thể cho em xin zalo hoặc fb để hỏi thêm 1 chút được ko ạ

thnghiachau · 21/7/20

iamcuong đã viết:
Thân gửi: Các Chú, các anh chị em trong diễn đàn.
Hiện em đang có 1 file excel có 1000 mã hàng, 1 folder có 1000 ảnh tương ứng với 1000 mã hàng (Tên sản phẩm đặt theo tên mã hàng)

- Em muốn thực hiện thao tác chèn ảnh vào comment hàng loạt như hướng dẫn sau thì liệu có phương án nào khả thi không ạ?
- Nếu không có PA nào khả thi thì các Chú, các anh chị em cho em xin link bài viết VBA về chèn ảnh tự động hàng loạt vào 1 CELL cũng được ạ.

Cám ơn các chú, các anh chị nhiều ạ.

Mình có làm một code chèn hình vào Comment trước kia.
Trước khi chèn thì chúng ta phải resize hình lại cho dung lượng nhỏ đi và vừa với size của comment box. Như bạn @HeSanbi sử dụng " thư viện WIA.ImageFile ", nhưng có máy có có máy không và phải thêm vài động tác nữa... thì mới sử dụng dc.
Cái mình làm là tạo ra một thumbnail là tạo ra một vùng Chart, dán hình vào đó và export ra, và dùng file này để chèn vào comment.
Các bạn có thể tham khảo code sau:

Mã:

Option Explicit

Sub InsertPicToComment()
Dim strFileThumbnail As String
    strFileThumbnail = CreateThumbnail("D:\Temp\Pic\IMG_0105.JPG", Sheet1, 100, 100)
    If Not Sheet1.Range("C5").Comment Is Nothing Then Sheet1.Range("C5").Comment.Delete
    With Sheet1.Range("C5").AddComment
        .Visible = True
        .Text Text:=""
        .Shape.Fill.UserPicture strFileThumbnail
        .Shape.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
        .Shape.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
        .Visible = False
    End With
    Kill strFileThumbnail
End Sub

Function CreateThumbnail(ByVal strFilePic As String, ByVal wksSheet As Worksheet, _
                         ByVal lngThumb_Width As Long, ByVal lngThumb_Height As Long) As String

    ' input jpg and temp file path
    Dim strFileThumbnail As String
    Dim strFolderPic As String
    With CreateObject("Scripting.FileSystemObject")
        strFolderPic = .GetParentFolderName(strFilePic)
        If Right(strFolderPic, 1) <> "\" Then strFolderPic = strFolderPic & "\"
        strFileThumbnail = strFolderPic & .GetBaseName(strFilePic) & "_Thumb." & .GetExtensionName(strFilePic)
    End With
 
    ' load picture to shape and RESIZE
    Dim oShapePic As Shape
    Set oShapePic = wksSheet.Shapes.AddPicture(Filename:=strFilePic, LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, _
                                                  Left:=20, Top:=20, Width:=lngThumb_Width, Height:=lngThumb_Height)

    ' create a chart
    Dim oChart As Chart
    Set oChart = wksSheet.Shapes.AddChart(xlColumnClustered, Width:=lngThumb_Width, Height:=lngThumb_Height).Chart
 
    ' copy shape picture to chart and export to file thumbnail
    oShapePic.Copy
    oChart.Parent.Activate
    oChart.Paste
    oChart.Export Filename:=strFileThumbnail, FilterName:="jpg"
   
    ' Delette shape picture to chart After export to file thumbnail
    oShapePic.Delete
    oChart.Parent.Delete
 
    CreateThumbnail = strFileThumbnail

End Function

HeSanbi · 21/7/20

thnghiachau đã viết:

Mình có làm một code chèn hình vào Comment trước kia.
Trước khi chèn thì chúng ta phải resize hình lại cho dung lượng nhỏ đi và vừa với size của comment box. Như bạn @HeSanbi sử dụng " thư viện WIA.ImageFile ", nhưng có máy có có máy không và phải thêm vài động tác nữa... thì mới sử dụng dc.
Cái mình làm là tạo ra một thumbnail là tạo ra một vùng Chart, dán hình vào đó và export ra, và dùng file này để chèn vào comment.
Các bạn có thể tham khảo code sau:

Mã:

Option Explicit

Sub InsertPicToComment()
Dim strFileThumbnail As String
    strFileThumbnail = CreateThumbnail("D:\Temp\Pic\IMG_0105.JPG", Sheet1, 100, 100)
    If Not Sheet1.Range("C5").Comment Is Nothing Then Sheet1.Range("C5").Comment.Delete
    With Sheet1.Range("C5").AddComment
        .Visible = True
        .Text Text:=""
        .Shape.Fill.UserPicture strFileThumbnail
        .Shape.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
        .Shape.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
        .Visible = False
    End With
    Kill strFileThumbnail
End Sub

Function CreateThumbnail(ByVal strFilePic As String, ByVal wksSheet As Worksheet, _
                         ByVal lngThumb_Width As Long, ByVal lngThumb_Height As Long) As String

    ' input jpg and temp file path
    Dim strFileThumbnail As String
    Dim strFolderPic As String
    With CreateObject("Scripting.FileSystemObject")
        strFolderPic = .GetParentFolderName(strFilePic)
        If Right(strFolderPic, 1) <> "\" Then strFolderPic = strFolderPic & "\"
        strFileThumbnail = strFolderPic & .GetBaseName(strFilePic) & "_Thumb." & .GetExtensionName(strFilePic)
    End With

    ' load picture to shape and RESIZE
    Dim oShapePic As Shape
    Set oShapePic = wksSheet.Shapes.AddPicture(Filename:=strFilePic, LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, _
                                                  Left:=20, Top:=20, Width:=lngThumb_Width, Height:=lngThumb_Height)

    ' create a chart
    Dim oChart As Chart
    Set oChart = wksSheet.Shapes.AddChart(xlColumnClustered, Width:=lngThumb_Width, Height:=lngThumb_Height).Chart

    ' copy shape picture to chart and export to file thumbnail
    oShapePic.Copy
    oChart.Parent.Activate
    oChart.Paste
    oChart.Export Filename:=strFileThumbnail, FilterName:="jpg"
 
    ' Delette shape picture to chart After export to file thumbnail
    oShapePic.Delete
    oChart.Parent.Delete

    CreateThumbnail = strFileThumbnail

End Function

Có nhiều phương pháp lấy kích thước File, cách của bạn không đúng nhé.
Ảnh sẽ bị méo mó đấy.

phamvucattien đã viết:
anh có thể cho em xin zalo hoặc fb để hỏi thêm 1 chút được ko ạ

Bạn có thể hỏi ngay trên bài viết này.

thnghiachau · 21/7/20

HeSanbi đã viết:
Có nhiều phương pháp lấy kích thước File, cách của bạn không đúng nhé.
Ảnh sẽ bị méo mó đấy.

mình khi sữ dụng thì sử lý biến "lngThumb_Width" và "lngThumb_Heigth" thì sẽ không bị méo đâu bạn!
Vì cái mình gởi là ý tưởng tổng quát, khi dùng thì tùy theo các bạn mà sử dụng như thế nào cho chuẩn....

batman1 · 21/7/20

thnghiachau đã viết:
mình khi sữ dụng thì sử lý biến "lngThumb_Width" và "lngThumb_Heigth" thì sẽ không bị méo đâu bạn!
Vì cái mình gởi là ý tưởng tổng quát, khi dùng thì tùy theo các bạn mà sử dụng như thế nào cho chuẩn....

Với ảnh gốc bất kỳ thì chiều dài sẽ lớn gấp x lần chiều cao. Với x > 1 thì chiều dài > chiều cao, x < 1 thì chiều dài < chiều cao, x = 1 thì chiều dài = chiều cao. Code của bạn không xác định được kích thước gốc thì bằng cách nào bạn bạn có ảnh không méo? Nếu bạn có tất cả các ảnh gốc với x = 1,5 thì dễ rồi. Chỉ cần chọn sao cho lngThumb_Width = 1,5 * lngThumb_Height. Nhưng nếu ảnh 1 có x = 1,5, ảnh 2 có x = 1,2, .... hoặc một số ảnh có x > 1 còn số khác có x < 1, số khác nữa có x = 1 thì bạn xác định tỉ lệ của ảnh gốc bằng cách nào? Thánh cũng bó tay. Phải xác định kích thước của ảnh gốc thôi.

Để không méo mó thì phải tính được tỉ lệ 2 kích thước của ảnh gốc. Để làm việc đó hoặc phải đọc được 2 kích thước gốc, hoặc làm như trong code của tôi khi CENTER = TRUE (center = TRUE có nghĩa là phóng to hoặc thu nhỏ ảnh để nó nằm gọn trong Target, nhưng tỷ lệ phóng to thu nhỏ = tỷ lệ 2 chiều của ảnh gốc)

Giúp đỡ mình tìm hàm trả ra kết quả là hình ảnh.

Công ty mình có trên 7000 bản vẽ kĩ thuật, việc tra cứu và triển khai cho NV làm thực sự tốn quá nhiều thời gian .Mỗi bản vẽ được đặt tên mã. Bản vẽ sẽ được chứa trong 1 folder ( Ví dụ ổ D ) Mình mong muốn là tạo ra 1 file excel khi gõ tên mã sẽ hiện ra bản vẽ đó . Khi cần sẽ gõ tên mã khác và...

www.giaiphapexcel.com

phamvucattien · 22/7/20

HeSanbi đã viết:
Có nhiều phương pháp lấy kích thước File, cách của bạn không đúng nhé.
Ảnh sẽ bị méo mó đấy.

Bạn có thể hỏi ngay trên bài viết này.

cám ơn anh ạ. em hành văn hơi lủng củng, anh thông cảm giúp em với ạ
đại ý là em có 2 vấn đề
vấn đề 1 là giống chủ post
vấn đề 2 là khi tham chiếu :
ví dụ ở sheets 1. có dữ liệu kèm với comment
khi em tham chiếu sang sheet 2 dùng hàm vlockup thì chỉ được dữ liệu ở trong Ô, còn comnet ko sang được ạ,
anh có cách nào giúp em với được ko ạ

fso56 · 11/9/20

Em chào các bác.
cách chèn ảnh vào comment em cũng có biết. Và cách làm ấy là thủ công chèn từng ảnh một vào tùng commment.
Các các cho em hỏi là có cách nào chèn tự động không ah. Kiểu như khi mình nhập tên cảu môt file ảnh (VD anh1) vào ô excel ấy thì tự động thêm cái ảnh ấy vào comment của ô đó không ah.
E, xin cám ơn.

Cần giúp: Chèn tự động ảnh vào comment trên excel

Cám ơn GPE

Thành viên mới

Cám ơn GPE

Thành viên mới

Thành viên GPE Hà Nội

Thành viên mới

File đính kèm

Lỡ bước sang ngang

Cám ơn GPE

File đính kèm

Huyền thoại GPE

Thành viên mới

Thành viên thường trực

Thành viên mới

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên mới

Supreme Сasual Dating - Real-life Girls

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Supreme Сasual Dating - Real-life Girls

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

Thành viên mới

Power Query

Facebook

Group