GDIplusCODE

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
エクセルWSの画像へのHyperLinkに縮小画像のコメントをつける
