Replace text in cell with picture (or insert picture into same cell)
Hi all, this is my first post here, and hope to help others in the future! Right now, though I am at a loss as to what to do.
I currently have a workbook with two sheets (developing with 2013, but also needs to work for 2007 if possible).
The first sheet is the printout form (picture 1), and the second is where the data is entered (picture 2).
The VBA runs through each row (see module snippets below) and populates the data in the correct cells, and then prints the form out.
What I would like to do, is during this process, if the text "z.1" through "z.9" is entered, it is replaced with a picture, or at least a corresponding picture would be entered into the same cell as the text (key in pic 2). These nine pictures are located in a subfolder of the same directory in which the excel file will be located (usb stick, which means drive letter will change between systems).
Currently, my wife attempts to do these sheets in word (using tables) that continue to overlap each other. Just trying to save her some time and frustration.
Any help on this would be greatly appreciated!
Here is what I have so far for the populate and print.
printout.jpgprint-list.jpg'This populates the Kardex sheet with each row.Sub PropagateForm() Dim ws1 As Worksheet, ws2 As Worksheet, r As Long, lr As Long Set ws1 = Worksheets("KARDEX_PRINTOUT") Set ws2 = Worksheets("PRINT_LIST") lr = ws2.Cells(Rows.Count, "A").End(xlUp).Row With ws1 For r = 3 To lr Range("B7").Value = ws2.Range("A" & r).Value Range("E7").Value = ws2.Range("B" & r).Value Range("E8").Value = ws2.Range("C" & r).Value Range("E9").Value = ws2.Range("D" & r).Value Range("E10").Value = ws2.Range("E" & r).Value Range("E13").Value = ws2.Range("F" & r).Value Range("E16").Value = ws2.Range("G" & r).Value Range("F7").Value = ws2.Range("H" & r).Value Range("F8").Value = ws2.Range("I" & r).Value Range("F9").Value = ws2.Range("J" & r).Value Range("F10").Value = ws2.Range("K" & r).Value Range("F13").Value = ws2.Range("L" & r).Value Range("F16").Value = ws2.Range("M" & r).Value Range("H7").Value = ws2.Range("N" & r).Value Range("H8").Value = ws2.Range("O" & r).Value Range("H9").Value = ws2.Range("P" & r).Value Range("H10").Value = ws2.Range("Q" & r).Value Range("H16").Value = ws2.Range("R" & r).Value Range("K7").Value = ws2.Range("S" & r).Value Range("K8").Value = ws2.Range("T" & r).Value Range("K9").Value = ws2.Range("U" & r).Value Range("K10").Value = ws2.Range("V" & r).Value Range("K13").Value = ws2.Range("W" & r).Value Range("K16").Value = ws2.Range("X" & r).Value Range("P7").Value = ws2.Range("Y" & r).Value Range("P8").Value = ws2.Range("Z" & r).Value Range("P9").Value = ws2.Range("AA" & r).Value Range("P10").Value = ws2.Range("AB" & r).Value Range("P13").Value = ws2.Range("AC" & r).Value Range("P16").Value = ws2.Range("AD" & r).Value Call PrintSave Next r End With Application.DisplayAlerts = False ThisWorkbook.Close False 'Application.Quit End Sub ________________________________________________ Sub PrintSave() PrintKardex 'CreateDir 'ExportPDF 'SaveStickerNewName End Sub _________________________________________________ Sub PrintKardex() 'below will print one copy of Kardex but change number to what is needed ActiveSheet.PrintOut Copies:=1 End Sub
Reply With Quote
Originally Posted by werafa
