PDA

View Full Version : [SOLVED] Variable Print Header



Glaswegian
10-12-2004, 06:16 AM
Seems to be my day for asking questions.....

I will be printing a large number of report pages from a workbook (around 500) and these will all go in our internal mail system to various Managers etc. I had thought that I could add the required details to the sheet Header via code, but I'm not sure how to do this (or even if it can be done).

I know I can place a cell value in the Header, so I'd thought of using a table containing the required addresses, but I don't know how to link that to the reports. The address table will have a matching field in each report. Each report will have a varying number of pages, e.g some will have only 1 page, some will have 4 or more. All page breaks and page style etc have been set by code.

Page 1 will go to Manager A at location B, pages 2 -6 will go to Manager C at location D and so on. Each Manager has a unique ID code.

Is there a way to add the address for each Manager to the print Header so that each print have the correct address for that Manager?

Thanks as always for any help.

Richie(UK)
10-12-2004, 06:50 AM
Hi Iain,

Yes, you can set the Header and Footer details by code. You may find, however, that the code is very slow (especially with the number of sheets that you are referring to).

The following code (provided to me by Ivan Moala, I think) is a much quicker alternative. It adds the same info to every sheet but hopefully you can adapt it to suit your needs - let me know if you need help. The variables are, I think, quite intuitive - strLH is the String variable for the Left Header etc.


Sub CustomHeaderFooterV3()
Dim ws As Worksheet
Dim strLH As String, strCH As String, strRH As String
Dim strLF As String, strCF As String, strRF As String
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With Sheet1
strLH = "&L" & .Range("C43").Value
strCH = "&C" & .Range("C44").Value
strRH = "&R" & .Range("C45").Value
strLF = "&L" & .Range("C46").Value
strCF = "&C" & .Range("C47").Value
strRF = "&R" & .Range("C48").Value
End With
'get values from Sheet1 (User Input)
For Each ws In ThisWorkbook.Worksheets
ws.Activate
ws.DisplayPageBreaks = False
Application.SendKeys "{ENTER}", False
Application.Dialogs(xlDialogPageSetup).Show _
Arg1:=strLH & strCH & strRH, _
Arg2:=strLF & strCF & strRF
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Sheet1.Activate
End Sub

HTH

Glaswegian
10-12-2004, 07:15 AM
Hi again Richie


Many thanks for your reply - superb code!

A bit over my head now, so any further assistance would be gratefully received.

I've attached a small sample sheet, just with bare data. The 'List' sheet shows some data - this will be split according to the ID code in column A. Is it possible to adapt your code so that for each ID Code, the address(from the 'Lookup' sheet) is dropped into the Header?

I have some similar other sheets but once I get the initial method I should be OK.

Regards

Richie(UK)
10-12-2004, 07:44 AM
Hi Iain,

Well, not tested, because I don't have access to a printer at the moment, but perhaps something like this:


Sub CustomHeaderFooterV3()
Dim ws As Worksheet
Dim strLH As String, strCH As String, strRH As String
Dim strLF As String, strCF As String, strRF As String
Dim rngCell As Range, rngData As Range, rngAdd As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set rngAdd = Range("Addresses")
'named range
With Worksheets("List")
Set rngData = .Range("A6:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
.SpecialCells(xlCellTypeConstants, xlNumbers)
For Each rngCell In rngData
strCH = "&C" & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 2)
' strLH = "&L" & .Range("C43").Value
' strCH = "&C" & .Range("C44").Value
' strRH = "&R" & .Range("C45").Value
' strLF = "&L" & .Range("C46").Value
' strCF = "&C" & .Range("C47").Value
' strRF = "&R" & .Range("C48").Value
For Each ws In ThisWorkbook.Worksheets
ws.Activate
ws.DisplayPageBreaks = False
Application.SendKeys "{ENTER}", False
Application.Dialogs(xlDialogPageSetup).Show _
Arg1:=strLH & strCH & strRH, _
Arg2:=strLF & strCF & strRF
Next
'do the printing
Next rngCell
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

With the named range referring to the data on the 'Lookup' sheet.

HTH

Glaswegian
10-13-2004, 04:05 AM
Richie



Many thanks - like the code and understand most of it. I've tried to amend it to suit but I'm getting a bit stuck. Also I don't quite follow the show Dialog box bit - I have to click on 'OK' to clear. This is what I've got so far - I've added a loop to look at the ID numbers in Col A and skip if they are the same - seems to be OK. My main problem is trying to print the correct pages with the correct header. I think I'm nearly there but I'm now getting errors like 'Block If without End If' and 'Invalid Next Control variable reference'. I can't seem to work this out and would appreciate any help.

Thanks


Sub CustomHeaderFooterV3()
Dim ws As Worksheet
Dim strLH As String, strCH As String, strRH As String
Dim strLF As String, strCF As String, strRF As String
Dim rngCell As Range, rngData As Range, rngAdd As Range
Dim i As Integer, x As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set rngAdd = Range("BranchAddress")
'named range
x = Worksheets("Test Print").HPageBreaks.Count
With Worksheets("Test Print")
Set rngData = .Range("A6:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
.SpecialCells(xlCellTypeConstants, xlNumbers)
For Each rngCell In rngData
If rngCell.Value <> rngCell.Offset(-2, 0).Value Then
strLH = "&B" & "&16" & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 2) & " " _
& Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 1)
' For Each ws In ThisWorkbook.Worksheets
' ws.Activate
Application.SendKeys "{ENTER}", False
Application.Dialogs(xlDialogPageSetup).Show _
Arg1:=strLH
' Next
For i = 1 To x
Worksheets("Test Print").Activate
ActiveSheet.PrintOut from:=i, To:=x - (x - i), copies:=1
'End If
Next rngCell
Next i
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Richie(UK)
10-13-2004, 04:27 AM
Hi Iain,

A quick reply only, I'm afraid, as I'm just about to leave the office for a while.

The SendKeys with Enter part was to OK the dialog box as it looped through each sheet (SendKeys isn't generally a good idea as it's not reliable, but it's part of the speed workaround in this code) - try adding it after the dialog box.

You have commented-out the End If line.

You have mixed-up the Next rngCell and Next i lines.

Glaswegian
10-13-2004, 07:35 AM
Ok - think I've got most bits sorted.



I've now got a problem in that I can't get x to increment, it stays at 1. Each ID will have a variable number of pages, and I think printing after applying the variable header is the best way (at least only one I can come up with). Here is the code so far


Sub CustomHeaderFooterV3()
Dim strLH As String, strCH As String, strRH As String
Dim strLF As String, strCF As String, strRF As String
Dim rngCell As Range, rngData As Range, rngAdd As Range
Dim i As Integer, x As Long
With Application
.ScreenUpdating = False
End With
Set rngAdd = Range("TestAddress")
'named range
x = Worksheets("Test Print").HPageBreaks.Count
With Worksheets("Test Print")
Set rngData = .Range("A6:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
.SpecialCells(xlCellTypeConstants, xlNumbers)
For i = 1 To x
For Each rngCell In rngData
If rngCell.Value <> rngCell.Offset(-2, 0).Value Then
strLH = "&B" & "&16" & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 2) & " " _
& Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 1)
Application.Dialogs(xlDialogPageSetup).Show _
Arg1:=strLH
Application.SendKeys "{ENTER}", False
Worksheets("Test Print").Activate
ActiveSheet.PrintOut from:=i, To:=x - (x - i), copies:=1
End If
Next rngCell
Next
End With
With Application
.ScreenUpdating = True
End With
End Sub


Thanks again for all assistance.