ftnbubba
10-20-2011, 07:26 AM
OK guys I am new to VBA and cannot figure out how to create a multiple page document from excel input.
Background - I am trying to create labels that can be printed from an excel report. The input file is read and written to a bookmarked template. I have that portion working, but what I cannot get to work is writing the second page and on. I have it to where its creating a new page at every break, but I really want them all to be in the same document so its easier to print out. I am not sure if this is possible using a template or not, like I said I am a cobol programmer and hate how massive this code looks, give me some working storage and tables already. So any help would be appriciated on how to get this working.
Thanks !
Public Sub PageBreaking()
' The Excel and Word Decs
Dim mobjExcel As Excel.Application
Dim mobjReport As Excel.Workbook
Dim mobjOpenShp As Excel.Worksheet
Dim mobjWord As Word.Application
Dim mobjLabel As Word.Document
Dim mobjRange As Word.Range
Dim mobjdocFielName As String
Dim mobjPath As String
'Working Storage Decs
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Dim palletHold As String
Dim wsWordTemplate As String
Dim wsWritingHere As Boolean
Dim intRow As Integer
Dim i As Integer
Dim mstrShpReport As String
Dim intSkuCounter As Integer
Dim wsPalletHold As String
' Working Storage for bookmark use
Dim wsOrderNumber As Excel.Range
Dim wsClient As Excel.Range
Dim wsPO As Excel.Range
Dim wsStartPage As Excel.Range
Dim wsEndPage As Excel.Range
Dim wsSKU1 As Excel.Range
Dim wsQuantity1 As Excel.Range
Dim wsSKU2 As Excel.Range
Dim wsQuantity2 As Excel.Range
Dim wsSKU3 As Excel.Range
Dim wsQuantity3 As Excel.Range
Dim wsSKU4 As Excel.Range
Dim wsQuantity4 As Excel.Range
Dim wsSKU5 As Excel.Range
Dim wsQuantity5 As Excel.Range
Dim wsSKU6 As Excel.Range
Dim wsQuantity6 As Excel.Range
' Grab the Excel input file
mstrShpReport = FileHelper.SelectFile("C:\Projects\Dist Label\App Files")
WorkbookToWorkOn = mstrShpReport
' If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set mobjExcel = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set mobjExcel = New Excel.Application
End If
On Error GoTo Err_Handler
'Open the workbook
Set mobjReport = mobjExcel.Workbooks.Open(FileName:=WorkbookToWorkOn)
'Process the specified tab in the workbook
Set mobjOpenShp = mobjReport.Sheets("Open Shipments Reportd")
intRow = 2
intSkuCounter = 1
wsPalletHold = mobjOpenShp.Range("F" & intRow)
' Loop through the excel spreadsheet and create the labels.
' Break when pallet changes
Do While mobjOpenShp.Range("A" & intRow) <> ""
If wsPalletHold = mobjOpenShp.Range("F" & intRow) Then
If intSkuCounter = 1 Then
'Opening the template
Set mobjWord = New Word.Application
With mobjWord
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Set mobjLabel = mobjWord.Documents.Add(Template:="C:\Projects\Dist Label\DisLabelTemplate.dotm")
Set wsOrderNumber = mobjOpenShp.Range("A" & intRow)
Set wsClient = mobjOpenShp.Range("C" & intRow)
Set wsPO = mobjOpenShp.Range("B" & intRow)
Set wsStartPage = mobjOpenShp.Range("F" & intRow)
Set wsEndPage = mobjOpenShp.Range("G" & intRow)
End If
Else
With mobjLabel.Bookmarks
.Item("Order_Number").Range.InsertAfter wsOrderNumber
.Item("Client").Range.InsertAfter wsClient
.Item("PO").Range.InsertAfter wsPO
.Item("Start_Page").Range.InsertAfter wsStartPage
.Item("End_Page").Range.InsertAfter wsEndPage
.Item("SKU_1").Range.InsertAfter wsSKU1
.Item("Quantity_1").Range.InsertAfter wsQuantity1
If intSkuCounter > 2 Then
.Item("SKU_2").Range.InsertAfter wsSKU2
.Item("Quantity_2").Range.InsertAfter wsQuantity2
End If
If intSkuCounter > 3 Then
.Item("SKU_3").Range.InsertAfter wsSKU3
.Item("Quantity_3").Range.InsertAfter wsQuantity3
End If
If intSkuCounter > 4 Then
.Item("SKU_4").Range.InsertAfter wsSKU4
.Item("Quantity_4").Range.InsertAfter wsQuantity4
End If
If intSkuCounter > 5 Then
.Item("SKU_5").Range.InsertAfter wsSKU5
.Item("Quantity_5").Range.InsertAfter wsQuantity5
End If
If intSkuCounter > 6 Then
.Item("SKU_6").Range.InsertAfter wsSKU6
.Item("Quantity_6").Range.InsertAfter wsQuantity6
End If
End With
intSkuCounter = 1
Set mobjWord = New Word.Application
With mobjWord
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Set mobjLabel = mobjWord.Documents.Add(Template:="C:\Projects\Dist Label\DisLabelTemplate.dotm")
Set wsOrderNumber = mobjOpenShp.Range("A" & intRow)
Set wsClient = mobjOpenShp.Range("C" & intRow)
Set wsPO = mobjOpenShp.Range("B" & intRow)
Set wsStartPage = mobjOpenShp.Range("F" & intRow)
wsPalletHold = mobjOpenShp.Range("F" & intRow)
Set wsEndPage = mobjOpenShp.Range("G" & intRow)
End If
Select Case intSkuCounter
Case Is = 1
wsWritingHere = True
Set wsSKU1 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity1 = mobjOpenShp.Range("E" & intRow)
Case Is = 2
Set wsSKU2 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity2 = mobjOpenShp.Range("E" & intRow)
Case Is = 3
Set wsSKU3 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity3 = mobjOpenShp.Range("E" & intRow)
Case Is = 4
Set wsSKU4 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity4 = mobjOpenShp.Range("E" & intRow)
Case Is = 5
Set wsSKU5 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity5 = mobjOpenShp.Range("E" & intRow)
Case Is = 6
Set wsSKU6 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity6 = mobjOpenShp.Range("E" & intRow)
End Select
If intSkuCounter = 6 Then
With mobjLabel.Bookmarks
.Item("Order_Number").Range.InsertAfter wsOrderNumber
.Item("Client").Range.InsertAfter wsClient
.Item("PO").Range.InsertAfter wsPO
.Item("Start_Page").Range.InsertAfter wsStartPage
.Item("End_Page").Range.InsertAfter wsEndPage
.Item("SKU_1").Range.InsertAfter wsSKU1
.Item("Quantity_1").Range.InsertAfter wsQuantity1
.Item("SKU_2").Range.InsertAfter wsSKU2
.Item("Quantity_2").Range.InsertAfter wsQuantity2
.Item("SKU_3").Range.InsertAfter wsSKU3
.Item("Quantity_3").Range.InsertAfter wsQuantity3
.Item("SKU_4").Range.InsertAfter wsSKU4
.Item("Quantity_4").Range.InsertAfter wsQuantity4
.Item("SKU_5").Range.InsertAfter wsSKU5
.Item("Quantity_5").Range.InsertAfter wsQuantity5
.Item("SKU_6").Range.InsertAfter wsSKU6
.Item("Quantity_6").Range.InsertAfter wsQuantity6
End With
intSkuCounter = 0
wsWritingHere = False
End If
intRow = intRow + 1
intSkuCounter = intSkuCounter + 1
Loop
If wsWritingHere = True Then
With mobjLabel.Bookmarks
.Item("Order_Number").Range.InsertAfter wsOrderNumber
.Item("Client").Range.InsertAfter wsClient
.Item("PO").Range.InsertAfter wsPO
.Item("Start_Page").Range.InsertAfter wsStartPage
.Item("End_Page").Range.InsertAfter wsEndPage
.Item("SKU_1").Range.InsertAfter wsSKU1
.Item("Quantity_1").Range.InsertAfter wsQuantity1
If intSkuCounter > 2 Then
.Item("SKU_2").Range.InsertAfter wsSKU2
.Item("Quantity_2").Range.InsertAfter wsQuantity2
End If
If intSkuCounter > 3 Then
.Item("SKU_3").Range.InsertAfter wsSKU3
.Item("Quantity_3").Range.InsertAfter wsQuantity3
End If
If intSkuCounter > 4 Then
.Item("SKU_4").Range.InsertAfter wsSKU4
.Item("Quantity_4").Range.InsertAfter wsQuantity4
End If
If intSkuCounter > 5 Then
.Item("SKU_5").Range.InsertAfter wsSKU5
.Item("Quantity_5").Range.InsertAfter wsQuantity5
End If
If intSkuCounter > 6 Then
.Item("SKU_6").Range.InsertAfter wsSKU6
.Item("Quantity_6").Range.InsertAfter wsQuantity6
End If
End With
End If
If ExcelWasNotRunning Then
mobjExcel.Quit
End If
'Make sure you release object references.
Set mobjOpenShp = Nothing
Set mobjReport = Nothing
Set mobjExcel = Nothing
Set mobjWord = Nothing
Set mobjLabel = Nothing
Set mobjRange = Nothing
'quit
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, "Error: " & Err.Number
Set mobjOpenShp = Nothing
Set mobjReport = Nothing
Set mobjExcel = Nothing
Set mobjWord = Nothing
Set mobjLabel = Nothing
Set mobjRange = Nothing
If ExcelWasNotRunning Then
mobjExcel.Quit
mobjWord.Quit
End If
End Sub
Background - I am trying to create labels that can be printed from an excel report. The input file is read and written to a bookmarked template. I have that portion working, but what I cannot get to work is writing the second page and on. I have it to where its creating a new page at every break, but I really want them all to be in the same document so its easier to print out. I am not sure if this is possible using a template or not, like I said I am a cobol programmer and hate how massive this code looks, give me some working storage and tables already. So any help would be appriciated on how to get this working.
Thanks !
Public Sub PageBreaking()
' The Excel and Word Decs
Dim mobjExcel As Excel.Application
Dim mobjReport As Excel.Workbook
Dim mobjOpenShp As Excel.Worksheet
Dim mobjWord As Word.Application
Dim mobjLabel As Word.Document
Dim mobjRange As Word.Range
Dim mobjdocFielName As String
Dim mobjPath As String
'Working Storage Decs
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Dim palletHold As String
Dim wsWordTemplate As String
Dim wsWritingHere As Boolean
Dim intRow As Integer
Dim i As Integer
Dim mstrShpReport As String
Dim intSkuCounter As Integer
Dim wsPalletHold As String
' Working Storage for bookmark use
Dim wsOrderNumber As Excel.Range
Dim wsClient As Excel.Range
Dim wsPO As Excel.Range
Dim wsStartPage As Excel.Range
Dim wsEndPage As Excel.Range
Dim wsSKU1 As Excel.Range
Dim wsQuantity1 As Excel.Range
Dim wsSKU2 As Excel.Range
Dim wsQuantity2 As Excel.Range
Dim wsSKU3 As Excel.Range
Dim wsQuantity3 As Excel.Range
Dim wsSKU4 As Excel.Range
Dim wsQuantity4 As Excel.Range
Dim wsSKU5 As Excel.Range
Dim wsQuantity5 As Excel.Range
Dim wsSKU6 As Excel.Range
Dim wsQuantity6 As Excel.Range
' Grab the Excel input file
mstrShpReport = FileHelper.SelectFile("C:\Projects\Dist Label\App Files")
WorkbookToWorkOn = mstrShpReport
' If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set mobjExcel = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set mobjExcel = New Excel.Application
End If
On Error GoTo Err_Handler
'Open the workbook
Set mobjReport = mobjExcel.Workbooks.Open(FileName:=WorkbookToWorkOn)
'Process the specified tab in the workbook
Set mobjOpenShp = mobjReport.Sheets("Open Shipments Reportd")
intRow = 2
intSkuCounter = 1
wsPalletHold = mobjOpenShp.Range("F" & intRow)
' Loop through the excel spreadsheet and create the labels.
' Break when pallet changes
Do While mobjOpenShp.Range("A" & intRow) <> ""
If wsPalletHold = mobjOpenShp.Range("F" & intRow) Then
If intSkuCounter = 1 Then
'Opening the template
Set mobjWord = New Word.Application
With mobjWord
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Set mobjLabel = mobjWord.Documents.Add(Template:="C:\Projects\Dist Label\DisLabelTemplate.dotm")
Set wsOrderNumber = mobjOpenShp.Range("A" & intRow)
Set wsClient = mobjOpenShp.Range("C" & intRow)
Set wsPO = mobjOpenShp.Range("B" & intRow)
Set wsStartPage = mobjOpenShp.Range("F" & intRow)
Set wsEndPage = mobjOpenShp.Range("G" & intRow)
End If
Else
With mobjLabel.Bookmarks
.Item("Order_Number").Range.InsertAfter wsOrderNumber
.Item("Client").Range.InsertAfter wsClient
.Item("PO").Range.InsertAfter wsPO
.Item("Start_Page").Range.InsertAfter wsStartPage
.Item("End_Page").Range.InsertAfter wsEndPage
.Item("SKU_1").Range.InsertAfter wsSKU1
.Item("Quantity_1").Range.InsertAfter wsQuantity1
If intSkuCounter > 2 Then
.Item("SKU_2").Range.InsertAfter wsSKU2
.Item("Quantity_2").Range.InsertAfter wsQuantity2
End If
If intSkuCounter > 3 Then
.Item("SKU_3").Range.InsertAfter wsSKU3
.Item("Quantity_3").Range.InsertAfter wsQuantity3
End If
If intSkuCounter > 4 Then
.Item("SKU_4").Range.InsertAfter wsSKU4
.Item("Quantity_4").Range.InsertAfter wsQuantity4
End If
If intSkuCounter > 5 Then
.Item("SKU_5").Range.InsertAfter wsSKU5
.Item("Quantity_5").Range.InsertAfter wsQuantity5
End If
If intSkuCounter > 6 Then
.Item("SKU_6").Range.InsertAfter wsSKU6
.Item("Quantity_6").Range.InsertAfter wsQuantity6
End If
End With
intSkuCounter = 1
Set mobjWord = New Word.Application
With mobjWord
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Set mobjLabel = mobjWord.Documents.Add(Template:="C:\Projects\Dist Label\DisLabelTemplate.dotm")
Set wsOrderNumber = mobjOpenShp.Range("A" & intRow)
Set wsClient = mobjOpenShp.Range("C" & intRow)
Set wsPO = mobjOpenShp.Range("B" & intRow)
Set wsStartPage = mobjOpenShp.Range("F" & intRow)
wsPalletHold = mobjOpenShp.Range("F" & intRow)
Set wsEndPage = mobjOpenShp.Range("G" & intRow)
End If
Select Case intSkuCounter
Case Is = 1
wsWritingHere = True
Set wsSKU1 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity1 = mobjOpenShp.Range("E" & intRow)
Case Is = 2
Set wsSKU2 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity2 = mobjOpenShp.Range("E" & intRow)
Case Is = 3
Set wsSKU3 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity3 = mobjOpenShp.Range("E" & intRow)
Case Is = 4
Set wsSKU4 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity4 = mobjOpenShp.Range("E" & intRow)
Case Is = 5
Set wsSKU5 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity5 = mobjOpenShp.Range("E" & intRow)
Case Is = 6
Set wsSKU6 = mobjOpenShp.Range("D" & intRow)
Set wsQuantity6 = mobjOpenShp.Range("E" & intRow)
End Select
If intSkuCounter = 6 Then
With mobjLabel.Bookmarks
.Item("Order_Number").Range.InsertAfter wsOrderNumber
.Item("Client").Range.InsertAfter wsClient
.Item("PO").Range.InsertAfter wsPO
.Item("Start_Page").Range.InsertAfter wsStartPage
.Item("End_Page").Range.InsertAfter wsEndPage
.Item("SKU_1").Range.InsertAfter wsSKU1
.Item("Quantity_1").Range.InsertAfter wsQuantity1
.Item("SKU_2").Range.InsertAfter wsSKU2
.Item("Quantity_2").Range.InsertAfter wsQuantity2
.Item("SKU_3").Range.InsertAfter wsSKU3
.Item("Quantity_3").Range.InsertAfter wsQuantity3
.Item("SKU_4").Range.InsertAfter wsSKU4
.Item("Quantity_4").Range.InsertAfter wsQuantity4
.Item("SKU_5").Range.InsertAfter wsSKU5
.Item("Quantity_5").Range.InsertAfter wsQuantity5
.Item("SKU_6").Range.InsertAfter wsSKU6
.Item("Quantity_6").Range.InsertAfter wsQuantity6
End With
intSkuCounter = 0
wsWritingHere = False
End If
intRow = intRow + 1
intSkuCounter = intSkuCounter + 1
Loop
If wsWritingHere = True Then
With mobjLabel.Bookmarks
.Item("Order_Number").Range.InsertAfter wsOrderNumber
.Item("Client").Range.InsertAfter wsClient
.Item("PO").Range.InsertAfter wsPO
.Item("Start_Page").Range.InsertAfter wsStartPage
.Item("End_Page").Range.InsertAfter wsEndPage
.Item("SKU_1").Range.InsertAfter wsSKU1
.Item("Quantity_1").Range.InsertAfter wsQuantity1
If intSkuCounter > 2 Then
.Item("SKU_2").Range.InsertAfter wsSKU2
.Item("Quantity_2").Range.InsertAfter wsQuantity2
End If
If intSkuCounter > 3 Then
.Item("SKU_3").Range.InsertAfter wsSKU3
.Item("Quantity_3").Range.InsertAfter wsQuantity3
End If
If intSkuCounter > 4 Then
.Item("SKU_4").Range.InsertAfter wsSKU4
.Item("Quantity_4").Range.InsertAfter wsQuantity4
End If
If intSkuCounter > 5 Then
.Item("SKU_5").Range.InsertAfter wsSKU5
.Item("Quantity_5").Range.InsertAfter wsQuantity5
End If
If intSkuCounter > 6 Then
.Item("SKU_6").Range.InsertAfter wsSKU6
.Item("Quantity_6").Range.InsertAfter wsQuantity6
End If
End With
End If
If ExcelWasNotRunning Then
mobjExcel.Quit
End If
'Make sure you release object references.
Set mobjOpenShp = Nothing
Set mobjReport = Nothing
Set mobjExcel = Nothing
Set mobjWord = Nothing
Set mobjLabel = Nothing
Set mobjRange = Nothing
'quit
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, "Error: " & Err.Number
Set mobjOpenShp = Nothing
Set mobjReport = Nothing
Set mobjExcel = Nothing
Set mobjWord = Nothing
Set mobjLabel = Nothing
Set mobjRange = Nothing
If ExcelWasNotRunning Then
mobjExcel.Quit
mobjWord.Quit
End If
End Sub