PDA

View Full Version : Solved: Insert comment pictures vba



Shazam
07-13-2006, 06:38 AM
Hi everyone :hi:


I have this code below, it will insert a comment picture when double clicking the cell in column C. In column B has the part# and column C has the formula that reference file path.



="Q:\Reference Photos\Part#\"&B3&".jpg"


My question is do I need that column C?
Is it possible that I could just double click the cell in column B that has the part# and the picture will appear. How can the code be modified to do that?
I would prefer not to use that helper column C.



Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Target.Column = 3 Then ' only respond to doubleclicks in column C
Cancel = True ' No need to edit the value in the cell so cancel that
pix Target
End If
End Sub




Sub pix(rngCell As Range)
Dim curWks As Worksheet
Dim myCell As Range
Dim c As Object
Set curWks = ActiveSheet

curWks.Columns("C").ClearComments

If Trim(rngCell.Value) = "" Then
'do nothing
ElseIf Dir(CStr(rngCell.Value)) = "" Then
'picture not there!
MsgBox rngCell.Value & " doesn't exist!"
Else
With rngCell.Offset(0, 0) 'Option 17 columns to the right of A (C)
.AddComment("").Shape.Fill.UserPicture (rngCell.Value)
For Each c In ActiveSheet.Comments
c.Shape.Width = 400
c.Shape.Height = 300
Next c
End With

End If
End Sub

Jacob Hilderbrand
07-13-2006, 08:05 AM
Change this:


If Target.Column = 3 Then

To this:


If Target.Column = 2 Then



Sub pix(rngCell As Range)

Dim curWks As Worksheet
Dim myCell As Range
Dim c As Object
Dim Path As String

Set curWks = ActiveSheet

curWks.Columns("C").ClearComments
Path = "Q:\Reference Photos\Part#\" & Range("B" & rngCell.Row).Text & ".jpg"

If Trim(Range("B" & rngCell.Row).Text) = "" Then
'do nothing
ElseIf Dir(Path) = "" Then
'picture not there!
MsgBox Path & " doesn't exist!"
Else
With rngCell.Offset(0, 0) 'Option 17 columns to the right of A (C)
.AddComment("").Shape.Fill.UserPicture (Path)
For Each c In ActiveSheet.Comments
c.Shape.Width = 400
c.Shape.Height = 300
Next c
End With
End If

End Sub

Shazam
07-13-2006, 08:46 AM
Hi, DRJ thank you for replying.


Your code works great but it does not delete the previous insert comment. The code I posted when double clicking on another cell it will delete the previous insert comment. It helps to keep the file small. Any way we can fix that?

lucas
07-13-2006, 08:50 AM
I think if you change this to a B it will work

From

curWks.Columns("C").ClearComments


To

curWks.Columns("B").ClearComments

Shazam
07-13-2006, 08:50 AM
Never mind I changed this line:



curWks.Columns("C").ClearComments


To



curWks.Columns("B").ClearComments


and now its perfect.


Thank You so much DRJ:bow:

Jacob Hilderbrand
07-13-2006, 01:49 PM
You're Welcome :beerchug:

Take Care

lucas
07-13-2006, 02:11 PM
Hey Shazam, looks like I beat you by seconds....