excel - How to Insert Pictures into Comments of a cell by a given cell name -

thanks macromarc problem has been resolved

the problem had code was putting in picture cell, , picture sized incorrectly. when filtered data pictures collapsed each other , did not great.

below correct code work macromarc

     private sub grabimagepasteintocell()      const picturenamecolumn string = "a"     'column picture name found     const picturepastecolumn string = "j"     'column picture pasted     const pathforpicture    string = "m:\users\dan\pictures\labpics\"    'path of pictures      dim picturefile         string     dim picturename         string 'picture name     dim lastpicturerow      long   'last row in use picture names     dim picturerow          long   'current picture row processed     dim picturepastecell    range     picturerow = 3 'starts row      on error goto err_handler     dim ws worksheet     set ws = activesheet    'replace better qualification     lastpicturerow = ws.cells(ws.rows.count, picturenamecolumn).end(xlup).row      'stop screen updates while macro running     application.screenupdating = false      'loop till last picture row     while (picturerow <= lastpicturerow) picturename = ws.cells(picturerow, picturenamecolumn).value2 if (picturename <> vbnullstring)     'check if pic present     picturefile = pathforpicture & picturename     set picturepastecell = ws.cells(picturerow, picturepastecolumn)      if (dir(picturefile & ".jpg") <> vbnullstring)         insertpicturetocomment picturefile & ".jpg", picturepastecell, 41, 41      elseif (dir(picturefile & ".png") <> vbnullstring)         insertpicturetocomment picturefile & ".png", picturepastecell, 100, 130      elseif (dir(picturefile & ".bmp") <> vbnullstring)         insertpicturetocomment picturefile & ".bmp", picturepastecell, 100, 130      else         'picture name there, no such picture         picturepastecell.value2 = "no picture found"     end if else     'picture name cell blank end if  picturerow = picturerow + 1     loop      on error goto 0      exit_sub:     ws.range("a10").select     application.screenupdating = true     exit sub      err_handler:     msgbox "error encountered. " & err.description, vbcritical, "error"     goto exit_sub      end sub 

the function below handles insertion of generic images cell's comment shape:

    function insertpicturetocomment(picturefilepath string, _                         picturerange range, _                         commentheight long, _                         commentwidth long)      dim piccomment comment     if picturerange.comment nothing         set piccomment = picturerange.addcomment     else         set piccomment = picturerange.comment             end if      piccomment.shape         .height = commentheight         .width = commentwidth         .lockaspectratio = msofalse         .fill.userpicture picturefilepath     end      end function 

i rewrote of other code, , refactored out function.

tested , working me. questions ask:

private sub grabimagepasteintocell()  const picturenamecolumn string = "a"     'column picture name found const picturepastecolumn string = "j"     'column picture pasted const pathforpicture    string = "m:\users\dan\pictures\labpics\"    'path of pictures  dim picturefile         string dim picturename         string 'picture name dim lastpicturerow      long   'last row in use picture names dim picturerow          long   'current picture row processed dim picturepastecell    range picturerow = 3 'starts row  on error goto err_handler dim ws worksheet set ws = activesheet    'replace better qualification lastpicturerow = ws.cells(ws.rows.count, picturenamecolumn).end(xlup).row  'stop screen updates while macro running application.screenupdating = false  'loop till last picture row while (picturerow <= lastpicturerow)     picturename = ws.cells(picturerow, picturenamecolumn).value2     if (picturename <> vbnullstring)         'check if pic present         picturefile = pathforpicture & picturename         set picturepastecell = ws.cells(picturerow, picturepastecolumn)          if (dir(picturefile & ".jpg") <> vbnullstring)             insertpicturetocomment picturefile & ".jpg", picturepastecell, 41, 41          elseif (dir(picturefile & ".png") <> vbnullstring)             insertpicturetocomment picturefile & ".png", picturepastecell, 100, 130          elseif (dir(picturefile & ".bmp") <> vbnullstring)             insertpicturetocomment picturefile & ".bmp", picturepastecell, 100, 130          else             'picture name there, no such picture             picturepastecell.value2 = "no picture found"         end if     else         'picture name cell blank     end if      picturerow = picturerow + 1 loop  on error goto 0  exit_sub: ws.range("a10").select application.screenupdating = true exit sub  err_handler: msgbox "error encountered. " & err.description, vbcritical, "error" goto exit_sub  end sub 

the function below handles insertion of generic images cell's comment shape:

function insertpicturetocomment(picturefilepath string, _                             picturerange range, _                             commentheight long, _                             commentwidth long)  dim piccomment comment if picturerange.comment nothing     set piccomment = picturerange.addcomment else     set piccomment = picturerange.comment end if  piccomment.shape     .height = commentheight     .width = commentwidth     .lockaspectratio = msofalse     .fill.userpicture picturefilepath end  end function