Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Pictures in comments Sub MyPix modification ??
This was posted some time ago, I can't find the original post, I was
wondering if this could be modified as noted by astericks below ie. the range affected Thanks Bart Option Explicit Sub Mypix() Dim c As Object Dim eMsg As String Dim Pathe As String Dim rngCell As Range Dim rngSheet As Range Dim curWks As Worksheet 'Handle errors On Error Goto endo 'Speed Application.ScreenUpdating = False 'Create reference Set curWks = ActiveSheet 'Employ reference With curWks 'Clear all old comments .Columns("A").ClearComments ****I imagine you would add ..Columns("f").ClearComments 'Define range as Col A1 to last row Col A Set rngSheet = .Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row) ***change to ******a1:a32 and f1:f32 End With 'Drive (& optionally directory) must end with "\" Pathe = "L:\" 'For each cell For Each rngCell In rngSheet 'If blank If Trim(rngCell.Value) = "" Then 'do nothing ElseIf Dir(Pathe & rngCell.Value & ".jpg") = "" Then 'picture not there! MsgBox rngCell.Value & " doesn't exist!" Else 'put picture rngCell.AddComment("").Shape.Fill.UserPicture (Pathe & rngCell.Value & ".jpg") End If Next rngCell 'Set size for all pictures For Each c In ActiveSheet.Comments c.Shape.Width = 400 c.Shape.Height = 300 Next c 'Destroy reference\ Set c = Nothing Set curWks = Nothing Set rngCell = Nothing Set rngSheet = Nothing 'Reset Application.ScreenUpdating = True 'Normal exit Exit Sub 'Errored out endo: 'Destroy reference\ Set c = Nothing Set curWks = Nothing Set rngCell = Nothing Set rngSheet = Nothing 'Reset Application.ScreenUpdating = True eMsg = MsgBox("Error number: " & Err.Number & " " & Err.Description, vbCritical) End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Pictures in comments Sub MyPix modification ??
Maybe...
With curWks 'Clear all old comments .Columns("A").ClearComments .columns("F").clearcomments Set rngSheet = .Range("A1:a32,f1:f32") End With ian bartlett wrote: This was posted some time ago, I can't find the original post, I was wondering if this could be modified as noted by astericks below ie. the range affected Thanks Bart Option Explicit Sub Mypix() Dim c As Object Dim eMsg As String Dim Pathe As String Dim rngCell As Range Dim rngSheet As Range Dim curWks As Worksheet 'Handle errors On Error Goto endo 'Speed Application.ScreenUpdating = False 'Create reference Set curWks = ActiveSheet 'Employ reference With curWks 'Clear all old comments .Columns("A").ClearComments ****I imagine you would add .Columns("f").ClearComments 'Define range as Col A1 to last row Col A Set rngSheet = .Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row) ***change to ******a1:a32 and f1:f32 End With 'Drive (& optionally directory) must end with "\" Pathe = "L:\" 'For each cell For Each rngCell In rngSheet 'If blank If Trim(rngCell.Value) = "" Then 'do nothing ElseIf Dir(Pathe & rngCell.Value & ".jpg") = "" Then 'picture not there! MsgBox rngCell.Value & " doesn't exist!" Else 'put picture rngCell.AddComment("").Shape.Fill.UserPicture (Pathe & rngCell.Value & ".jpg") End If Next rngCell 'Set size for all pictures For Each c In ActiveSheet.Comments c.Shape.Width = 400 c.Shape.Height = 300 Next c 'Destroy reference\ Set c = Nothing Set curWks = Nothing Set rngCell = Nothing Set rngSheet = Nothing 'Reset Application.ScreenUpdating = True 'Normal exit Exit Sub 'Errored out endo: 'Destroy reference\ Set c = Nothing Set curWks = Nothing Set rngCell = Nothing Set rngSheet = Nothing 'Reset Application.ScreenUpdating = True eMsg = MsgBox("Error number: " & Err.Number & " " & Err.Description, vbCritical) End Sub -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
printing comments with pictures | Excel Discussion (Misc queries) | |||
Comments and Pictures | Excel Programming | |||
HOW CAN I PUT GRAPHICS/PICTURES IN A COMMENTS BOX IN EXCEL | Excel Discussion (Misc queries) | |||
can pictures be inserted into comments | Excel Programming | |||
code for pictures in comments | Excel Programming |