Picture?

[DougDR]

<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0mm 5.4pt 0mm 5.4pt; mso-para-margin:0mm; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]--> Dear Mike/ or anyone

Thank you for your support. I would like to ask a number of questions but for now just one.
Your trick 42 shows how to put pictures into the comment of a cell. It was based on a single cell.
I have a need to have it happen row by row based on a part number which is also the Folder name in which the pictures are placed and based on the picture name, both of these are in the row in question. The picture needs to appear in the comment of the description cell in the same row. There for in a row you have the part number ##-##-NNNN and the picture name @@@@@.jpg, the folder where the picture is E:\My Documents\####\######\##-##-NNNN

Hope you can help

 

[SuperFerret]

It's ok, we've all been there!

I've tried to mock-up what you're working with to test, so give this a try.

I added the formula: ="E:\Wherever_images_stored\"&BH1&".jpg" (where BH1 is the image names)

Then this goes in a new Module:

Option Explicit
Sub Add_Comments()
    Dim myPict As Object
    Dim curWks As Worksheet
    Dim myRng As Range
    Dim myCell As Range
    
    Set curWks = Sheets(1) ' Change to suit
    
    With curWks
      Set myRng = .Range("BI1", .Cells(.Rows.Count, "BI").End(xlUp))
    End With
    
    curWks.Columns("K").ClearComments
    
    For Each myCell In myRng.Cells
      If Trim(myCell.Value) = "" Then
        'do nothing
      ElseIf Dir(CStr(myCell.Value)) = "" Then
        'picture not there!
      MsgBox myCell.Value & " Doesn't exist!"
      Else
        With myCell.Offset(0, -50) '50 columns to the left of BH (K)
            .AddComment("").Shape.Fill.UserPicture (myCell.Value)
        End With
      End If
    Next myCell
End Sub

Give this a go on a COPY of your workbook to test!

 

[DougDR]

Thank you so much. I will try it right away and come back to you if there are any problems ................. if you don't mind?

 

[SuperFerret]

Thank you so much. I will try it right away and come back to you if there are any problems ................. if you don't mind?

I don't mind at all, I'm still learning this stuff myself so any feedback is great!

 

[DougDR]

<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0mm 5.4pt 0mm 5.4pt; mso-para-margin:0mm; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]--> Hi SuperFerret

I set set CD11 to this “=CD10&"\"&E11&"\"&BH11” which gives me a value of “E:\My Documents\Bid or Buy\New SearchDesign Stock\SD-CC-0001\SD151e.jpg” The SD-**-#### is the folder where the picture lies.

I also set the macro to “Ctlr p”

All Information starts in row 11.

When I run it, it stops at “AddComment("").Shape.Fill.UserPicture (myCell.Value)
“
Have I set the curWks right?


“Sub Macro2()
'
' Macro2 Macro
' Macro recorded 2011/06/14 by DOUG DAVEY
'
' Keyboard Shortcut: Ctrl+p
'
Dim myPict As Object
Dim curWks As Worksheet
Dim myRng As Range
Dim myCell As Range

Set curWks = ThisWorkbook.Sheets("ListingControl") ' Change to suit

With curWks
Set myRng = .Range("CD11", .Cells(.Rows.Count, "CD").End(xlUp))
End With

curWks.Columns("K").ClearComments

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'do nothing
ElseIf Dir(CStr(myCell.Value)) = "" Then
'picture not there!
MsgBox myCell.Value & " Doesn't exist!"
Else
With myCell.Offset(0, -50) '50 columns to the left of BH (K)
.AddComment("").Shape.Fill.UserPicture (myCell.Value)
End With
End If
Next myCell

End Sub

 

[SuperFerret]

It seems to work fine if I rename my sheet to ListingControl

Try this one:

Option Explicit
Sub Add_Comments()
    Dim myPict As Object
    Dim curWks As Worksheet
    Dim myRng As Range
    Dim myCell As Range
 
    Set curWks = Sheets("[COLOR=red]ListingControl[/COLOR]") ' Change to suit
 
    With curWks
      Set myRng = .Range("[COLOR=red]CD11[/COLOR]", .Cells(.Rows.Count, "[COLOR=red]CD[/COLOR]").End(xlUp))
    End With
 
    curWks.Columns("[COLOR=red]K[/COLOR]").ClearComments
 
    For Each myCell In myRng.Cells
      If Trim(myCell.Value) = "" Then
        'do nothing
      ElseIf Dir(CStr(myCell.Value)) = "" Then
        'picture not there!
      MsgBox myCell.Value & " Doesn't exist!"
      Else
        [COLOR=red]With myCell.Offset(0, -71) '71 columns to the left of BH (K)[/COLOR]
            .AddComment("").Shape.Fill.UserPicture (myCell.Value)
        End With
      End If
    Next myCell
End Sub

Also, when posting code to the forum, it's easier to read if you paste it in, highlight the code then hit the # symbol. This shows it in the box like above.

 

[DougDR]

<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0mm 5.4pt 0mm 5.4pt; mso-para-margin:0mm; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]--> Fantastic ,,,, Fantastic …. It works great. Thank you so much … so very very much.

Just one thing, (there always seems to be just one thing …… go figure ….and you have already done more than I should be asking for), how can I at the same time set the size of the comment box?

 

[SuperFerret]

Fantastic ,,,, Fantastic …. It works great. Thank you so much … so very very much.

Just one thing, (there always seems to be just one thing …… go figure ….and you have already done more than I should be asking for), how can I at the same time set the size of the comment box?

Glad it's working so far!

That I'm afraid is beyond my current capabilities, sorry. Hopefully someone here may be able to offer some advice on that but I'll have to bow out on that one!

 

[SuperFerret]

I finish soon but a quick search and I came across this:

.Comment.Shape.ScaleWidth 5.87, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft

But I'm not sure whereabouts this needs to be added into the existing code, you could always give it a go?

 

[DougDR]

Thank you so much for your help.

I finish soon but a quick search and I came across this:

.Comment.Shape.ScaleWidth 5.87, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft

But I'm not sure whereabouts this needs to be added into the existing code, you could always give it a go?

 

[DougDR]

Thanks to – SuperFerret – who helped with my problem so well, I have to believe she/he will be blessed soon.
After giving me the solution below, I asked if there was a way to at the same time change the size of the comment widow.
She/He fond the following:-


.Comment.Shape.ScaleWidth 5.87, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft

I just don’t know where to place it in the code to make it work.
Can someone help please


Option Explicit
Sub Add_Comments()
Dim myPict As Object
Dim curWks As Worksheet
Dim myRng As Range
Dim myCell As Range

Set curWks = Sheets(" ListingControl") ' Change to suit

With curWks
Set myRng = .Range("CD11", .Cells(.Rows.Count, "CD").End(xlUp))
End With

curWks.Columns(" K").ClearComments

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'do nothing
ElseIf Dir(CStr(myCell.Value)) = "" Then
'picture not there!
MsgBox myCell.Value & " Doesn't exist!"
Else
With myCell.Offset(0, -71) '71 columns to the left of BH (K)
.AddComment("").Shape.Fill.UserPicture (myCell.Value)
End With
End If
Next myCell
End Sub