plainhavoc

05-17-2017, 08:25 PM

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.

'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

1920419205

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.

'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

1920419205