Ytdyklly

I'm asking for your help. My research ended up in 2 different macros that combined will give a good utility for my work.

1. This VBA code will insert image as comment.


2. This VBA code will fetch Hyperlinks(Local folder path only, not web
   based URL) and paste them in destination cell.

I really tried to combine them to do one job, but I guess I don’t have enough knowledge on this.

I tried to make a single script that gets the links from source range

Set Rng = Application.InputBox("Please select the url cells:")

Then prompt for destination cells (Application.InputBox("Please select a cell to put the image as comment:).

Now This is the tricky part for me, I need the images to be inserted as comment as the 1st code does to the destination range user selects.

Can anyone guide to achieve this excellent tweak

Sub InsertPictureAsComment()

Dim PicturePath As String

Dim CommentBox As Comment

'Pick A File to Add via Dialog (PNG or JPG)

       With Application.FileDialog(msoFileDialogFilePicker)

        .AllowMultiSelect = True

        .title = "Select Comment Image"

        .ButtonName = "Insert Image"

        .Filters.clear

        .Filters.Add "Images", "*.png; *.jpg"

        .Show



        'Store Selected File Path

          On Error GoTo UserCancelled

            PicturePath = .SelectedItems(1)

          On Error GoTo 0

        End With



    'Clear Any Existing Comment

      Application.ActiveCell.ClearComments



    'Create a New Cell Comment

    Set CommentBox = Application.ActiveCell.AddComment



    'Remove Any Default Comment Text

      CommentBox.Text Text:=""



    'Insert The Image and Resize

      CommentBox.Shape.Fill.UserPicture (PicturePath)

      CommentBox.Shape.ScaleHeight 6, msoFalse, msoScaleFormTopLeft

      CommentBox.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft



    'Ensure Comment is Hidden (Swith to TRUE if you want visible)

      CommentBox.Visible = False



    Exit Sub



    'ERROR HANDLERS 

UserCancelled: MsgBox "Done"

End Sub

'Next code-

Sub URLToCellPictureInsert()



    Dim Pshp As Shape

    Dim xRg As Range

    Dim xCol As Long



    On Error Resume Next



    Set Rng = Application.InputBox("Please select the url cells:", "", Selection.Address, , , , , 8)

    If Rng Is Nothing Then Exit Sub

    Set xRg = Application.InputBox("Please select a cell to put the image as comment:", "", , , , , , 8)



    If xRg Is Nothing Then Exit Sub



    Application.ScreenUpdating = False



    For i = 1 To Rng.Count

        filenam = Rng(i)

        ActiveSheet.Pictures.Insert(filenam).Select

        Set Pshp = Selection.ShapeRange.Item(1)



        If Pshp Is Nothing Then GoTo lab



        xCol = cell.Column + 1

        Set xRg = xRg.Offset(i - 1, 0)

        With Pshp

            .LockAspectRatio = msoFalse

            .Width = 80

            .Height = 80

            .Top = xRg.Top + (xRg.Height - .Height) / 2

            .Left = xRg.Left + (xRg.Width - .Width) / 2

        End With

lab:

        Set Pshp = Nothing

        Range("A2").Select

    Next



    Application.ScreenUpdating = True

End Sub