Macro code to show images in excel comments

excel_2009

Active Member
Joined
Sep 14, 2009
Messages
308
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 :)
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
5,995
Try incorporating this statement:
Code:
If Right(cell.value,4) = ".jpg" Then
 

excel_2009

Active Member
Joined
Sep 14, 2009
Messages
308
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 :)
 

Forum statistics

Threads
1,081,678
Messages
5,360,462
Members
400,586
Latest member
Minty

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top