Replace text in cell with picture (or insert picture into same cell)

[plainhavoc]

Thank you so much, and my apologies for such a long delay in replying.

mdmackillop, I attempted your first choice, and made a third worksheet (The original 2 were occupied with the print_list and Kardex_printout). The pictures were inserted there, and labeled pic 1-9 respectively. Then added your first script (finishing through to pic9), and attempted.

When reaching the "If Target.Count >1 Then Exit Sub" I get an error 91. So, by commenting that out, it continues to "Select Case Case (Target.Formula)" which also results in an error 91.

There are only six rows populated with information presently for testing, and it is attempting to print 316 pages. Any clue why it would not detect the last row?

Here is the entire scrip as it is currently sitting.

'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()
Worksheet_change
PrintKardex
'CreateDir
'ExportPDF
'SaveStickerNewName
'NextSticker
End Sub




Private Sub Worksheet_change(Optional ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Select Case LCase(Target.Formula)
    Case "z.1"
        Sheets("pics").Shapes("Picture 1").Copy
    Case "z.2"
        Sheets("pics").Shapes("Picture 2").Copy
    Case "z.3"
        Sheets("pics").Shapes("Picture 3").Copy
    Case "z.4"
        Sheets("pics").Shapes("Picture 4").Copy
    Case "z.5"
        Sheets("pics").Shapes("Picture 5").Copy
    Case "z.6"
        Sheets("pics").Shapes("Picture 6").Copy
    Case "z.7"
        Sheets("pics").Shapes("Picture 7").Copy
    Case "z.8"
        Sheets("pics").Shapes("Picture 8").Copy
    Case "z.9"
        Sheets("pics").Shapes("Picture 9").Copy
    End Select
    ActiveSheet.Paste
    Selection.Top = Target.Top
    Target.Select
End Sub




Sub PrintKardex()
    'below will print one copy of Kardex but change to what is needed
    ActiveSheet.PrintOut Copies:=1
End Sub