VBAからGDI+を使う資料集
inet上の達人の方々から御教示いただいたコードを少しアレンジさせてもらっています(切り貼りとも言います)。
  1. ホーム
  2. GDI+
  3. HyperLinkに縮小画像のコメントをつける


エクセルWSの画像へのHyperLinkに縮小画像のコメントをつける

エクセルワークシートの画像へのHyperLinkが入ったセルのコメントに、縮小画像を表示します

Sub setCommentToHyperLinks()
    Dim myRange As Range
    Dim item As Hyperlink
    
    For Each item In ActiveSheet.UsedRange.Hyperlinks
        If UCase(Right(item.Address, 3)) = "JPG" Then
            makeThumbnail item.Address, "C:\test.BMP"
            Set myRange = item.Parent
            With myRange
                .ClearComments
                .AddComment
                '下記引数のファイル名は定数もしくはstring * 50とサイズ指定で、かつ一杯の文字列が入った文字列変数でないとエラーになる
                .Comment.Shape.Fill.UserPicture "C:\test.BMP"
            End With
        End If
    Next
End Sub

Private Function makeThumbnail(ByVal SrcFileName As String, ByVal DstFileName As String) As Boolean
    Dim udtInput  As GdiplusStartupInput
    Dim EncoderId As GUID
    Dim lngToken  As Long
    Dim pSrcImage As Long
    Dim pDstImage As Long
    Dim lngStatus As Long

    udtInput.GdiplusVersion = 1
    If GdiplusStartup(lngToken, udtInput, ByVal 0&) <> 0 Then
        Exit Function
    End If
    lngStatus = GdipLoadImageFromFile(ByVal StrPtr(SrcFileName), pSrcImage)
    If lngStatus = 0 Then
        lngStatus = GdipGetImageThumbnail(pSrcImage, 160, 120, pDstImage, 0, ByVal 0&)
        GdipDisposeImage pSrcImage
    End If
    If lngStatus <> 0 Then
        GdiplusShutdown lngToken
        Exit Function
    End If
    
    CLSIDFromString ByVal StrPtr(CLSID_BMP), EncoderId
    If GdipSaveImageToFile(pDstImage, ByVal StrPtr(DstFileName), EncoderId, ByVal 0&) = 0 Then
        makeThumbnail = True
    End If
    GdipDisposeImage pDstImage
    GdiplusShutdown lngToken
End Function