Macro code to show images in excel comments

excel_2009

Active Member
Joined
Sep 14, 2009
Messages
318
Hi everyone,

I have some coding that displays images within a comment box when the macro is ran, the image urls are in column H.

The coding is as follows and works perfectly fine, however it needs a modification which I cannot figure out.

I need the coding to check the whole of column H and only create the image comment IF there is a jpg in the cell. i.e www.google.com/image/test1.jpg would have the image generated in the comment whereas this value Hello testing would not i.e. the macro should skip cells that are blank and cells that do not contain the value jpg.

Here is the current coding, any help would be greatly appreciated:

Code:
Sub image()


Dim rng As Range, cell As Range
With ActiveSheet
If Range("H2").Value <> "" Then
Set rng = .Range(.Range("H2"), .Range("H2").End(xlDown))
ElseIf Range("H2") <> "" Then
Set rng = .Range("H2")
Else
End
End If
End With


For Each cell In rng
cell.Select
On Error Resume Next
If Selection.Value <> "" Then
Selection.AddComment
Selection.Comment.Visible = False
Selection.Comment.Text Text:=""
Selection.Comment.Visible = True
Selection.Comment.Shape.Select True


Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 250
Selection.ShapeRange.Width = 250


Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.UserPicture ActiveCell.Value
ActiveCell.Comment.Visible = False
Else
End
End If
Next
End Sub

Thank you :)
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Hi John,

I have tried incorporating the suggestion however once doing so the coding stops at H2?

Code:
Sub image()


Dim rng As Range, cell As Range
With ActiveSheet




If Range("H2").Value = ".jpg" Then
Set rng = .Range(.Range("H2"), .Range("H2").End(xlDown))
ElseIf Range("H2") <> "" Then
Set rng = .Range("H2")
Else
End
End If
End With


For Each cell In rng
cell.Select
On Error Resume Next
If Selection.Value <> "" Then
Selection.AddComment
Selection.Comment.Visible = False
Selection.Comment.Text Text:=""
Selection.Comment.Visible = True
Selection.Comment.Shape.Select True


Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 250
Selection.ShapeRange.Width = 250


Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.UserPicture ActiveCell.Value
ActiveCell.Comment.Visible = False
Else
End
End If
Next
End Sub

Thank you :)
 
Upvote 0

Forum statistics

Threads
1,214,861
Messages
6,121,969
Members
449,059
Latest member
oculus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top