2 Attachment(s)
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.
Code:
'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
Attachment 19204Attachment 19205
