Wondering if anyone at this forum can
add to the thread I have running here:
http://www.mrexcel.com/board2/viewtopic.php?t=95505
Wondering if anyone at this forum can
add to the thread I have running here:
http://www.mrexcel.com/board2/viewtopic.php?t=95505
Ornithopter:
I'm wondering if there is any way to insert a Range of cells into the
footer. The effect I'm looking for is the same as if you were to go
to 'Page Setup'>Sheet>'Rows to Repeat at Top' except I want
'Rows to Repeat at Bottom'.
I have tried the following with no luck:
Private Sub Workbook_BeforePrint(Cancel As Boolean) With ActiveSheet.PageSetup .LeftFooter = Range("B237:M239").Text End With End Suband formatting that I would like at the bottom of every
Where the range "B237:M239" contains the information
page.
Any ideas?
Ornithopter:
If someone believes this is not possible,
that information would also be helpful.
Damon Ostrander:
Hi Ornithopter,
Your approach is correct and should work, but you cannot assign the text of a range of multiple cells to a single text string--you must do it one cell at a time, like this:
This basically concatenates all the cell text to produce the desired string..LeftFooter = [B237].Text & [C237].Text & ... & [M239].Text
This may not completely produce the desired result, though, if you are expecting a carriage return and linefeed between the text contained in different rows of cells. In order to add line feeds you must concatenate vbLF (or perhaps vbCrLf) into the string where you want the new line to occur.
_________________
Keep Excelling.
Damon
Ornithopter:
Hmmm....
Thanks Damon.
It is unfortunate that there is no way to maintian
the formatting of the cells as they have borders
and pictures that I would like to include at the
bottom of every page.
I guess that it would be best to import the
printable area into Word and do it from there?
Ornithopter:
Another Solution I just thought of (to stay in excel)
would be to have 2 sheets:
one with data, the other with the footer.
Then write a macro that:
1) Calculates how many rows fit on
the current page settings.
2) Calculates how many rows the footer
range requires.
3) Removes all 'Old' footers (if I ran the
macro before)
4) Inserts a copy of the footer at regular
calculated intervals so that it appears
at the bottom of every page and gives
the effect I want.
Thoughts?
Last edited by Aussiebear; 04-10-2023 at 11:49 PM. Reason: Adjusted the code tags
BUMP...
I'm pretty much thinking that if Damon and DRJ didn't come up with anything, you're pretty much SOL. However....have you considered printing it from Word, which has normal headers and footers?
You could link your data via a mail merge...
~Anne Troy
Hi Ornithopter,
I should be able to get something together for you to accomplish this, but I'm not sure how long I can devote today to this. I can tell you that this will be my only side project for the day
I'll let you know!
Matt
Dreamboat :
Yah I thought about the word option... it's still a possibility.
I am trying to keep it in Excel because the people at work
prefer it and get scared if they have to use more then one
app at the same time
Mvidas:
What is the plan of attack with your idea?
If you're short on time, just explain what you're thinking, I could
give it a try (I hate using up other peoples time when, technically,
I'm paid to do this). I will post my findings (successful or not).
Hi Ornithopter,
If you want to use Word it should be possible to do it behind the scenes so that the Users don't know anything about it - they just press a button and it prints. If Matt doesn't get you sorted I don't mind having a play with it. Is your print likely to be more than one page wide? For that matter is your footer likely to be more than one page wide??
Enjoy,
Tony
---------------------------------------------------------------
Give a man a fish and he'll eat for a day.
Teach him how to fish and he'll sit in a boat and drink beer all day.
I'm (slowly) building my own site: www.WordArticles.com
It's not a problem, I actually just had 20 minutes while waiting for data from a co-worker, so I just got this done.
While the code is commented, I'll briefly explain what it does before I post it.
-Copies the sheet into a new one, placed before the active worksheet
-Figures out the height of the 'footer' cells
-Loops through each page, figures out where to insert the footer range, then copies the range to the bottom of that page
This works for me in Excel 2000, if you have a different version or are just experiencing any issues, let me know what they are and I'll work through them to get it working for you. If you want to use this macro each time the sheet is to be printed, un-comment the last 4 lines in the sub
Sub RowsToRepeatAtBottomOfPrintedPage() 'http://www.vbaexpress.com/forum/showthread.php?t=426 Dim hNum As Long, h As Long, x As Long, Ftr As Range, FtrH As Double, FtrHt As Double, nM As String nM = Mid(ActiveSheet.Name, 1, 21) 'First 21 characters of sheet name ActiveSheet.Copy before:=Sheets(ActiveSheet.Index) 'Copy current sheet and place it before active sheet ActiveSheet.Name = "Printable " & nM 'Rename new sheet to be "Printable " and first 21 characters of original name Set Ftr = Rows("237:239") 'Set Footer range / Rows to repeat at the bottom of the page FtrH = Ftr.Height 'Set height of footer Range("A1").SpecialCells(xlLastCell).Select 'Select last cell in sheet, necessary while using hpagebreaks for some reason h = 1 'Horizontal page break counter Do FtrHt = FtrH 'Set temp footer height variable to equal footer height hNum = ActiveSheet.HPageBreaks(h).Location.Row 'Set row variable to page break row number For x = 1 To ActiveSheet.UsedRange.Rows.Count 'Loop through rows to calculate height (to see where to put footer) FtrHt = FtrHt - Rows(hNum - x).Height 'Subtract row from temp footer height If FtrHt <= 0 Then Exit For 'Once enough rows have been looped through to make room for footer, exit loop Next x 'Next row Ftr.Copy 'Copy footer range Rows(hNum - x).Insert shift:=xlDown 'Insert footer range at end of sheet Application.CutCopyMode = False 'Clear clipboard h = h + 1 'Next H pagebreak counter Loop Until h > ActiveSheet.HPageBreaks.Count 'Loop to next page, unless already on last page Range("A1").Select 'Select first cell again 'Uncomment the following lines if this will be used each time the page is printed 'ActiveSheet.PrintOut 'Application.DisplayAlerts = False 'ActiveSheet.Delete 'Application.DisplayAlerts = True End Sub
Last edited by Aussiebear; 04-10-2023 at 11:51 PM. Reason: Adjusted the code tags
Ornithopter , which version of excel are you using ?
In XP it's possible to insert a minor picture in the footer.
So my suggestion would be that you lookup a code to convert and save your range to a picture (I know it's out there, I've seen it), and load it into the footer with
ActiveSheet.PageSetup.LeftFooterPicture.Filename = "D:\range2.gif"
Originally Posted by tommy bak
http://xcelfiles.homestead.com/VB_Quick17.html
Courtesy of Mr. Ivan Moala.
Regards, Zack Barresse
Check out the KB! :|: BOARD TAGS: WHAT ARE THEY AND HOW DO I USE THEM
What is a Microsoft MVP? | Free Microsoft Courses | My Book on Excel Tables
The code to copy a range as a picture in excel would be
But VBA doesn't have SavePicture or a similar method available, so you'd have to copy the range as a picture, go to Paint (or similar program), paste it and save it, then you can reference the picture that way.Range("B237:M239").CopyPicture
You can also copy the range as a picture by selecting the range, holding down SHIFT, clicking Edit, then selecting copy picture (only available by holding down Shift while clicking edit (or shift-alt-E))
Last edited by Aussiebear; 04-10-2023 at 11:52 PM. Reason: Adjusted the code tags
Cool
Thanks Firefytr
I knew it was somewhere. I've been searching for Harald Staff. I'm sure he hs made one too, just could't find it :-)
Tommy Bak
Np Tommy. I was actually just toying with that code a couple of weeks ago, so it was still fresh in the ol' noggin.
Regards, Zack Barresse
Check out the KB! :|: BOARD TAGS: WHAT ARE THEY AND HOW DO I USE THEM
What is a Microsoft MVP? | Free Microsoft Courses | My Book on Excel Tables
Thank you everyone for you amazing input!!!
That kewl how you can copy a range as a picture!
I wonder why MS never thought of letting you save/paste
that information somewhere in your excel spreadsheet?
Mvidas:
Thanks a million for the code, I'll try it in a few mins ;-)
PS
I'm also running excel 2000
Muahaha... now that I have everyone's create juices flowing,
I will try to find out what use CopyPicture is supposed to have...
The only times I've ever used copypicture is when I am putting a chart into powerpoint and don't want to have an actual chart in the presentation. Other than that, I've never used it
Matt
Mvidas:
I tried your script and it works beautifully except that
it doesn't put a footer on the last page. I have modified
your script to include the ability to do this.
I also made a modification to accept a selected range
as the rows to insert as the footer. You would need
to make a non-modal form that prompts the user to
select a range for the footer (my solution) or simply
put some error checking in to make sure there is a
range selected. Also, I refactored the code so that
it's easier for me to understand (sorry I'm a java
programmer and I can't stand one-letter variable names)
And here we go:
Option Explicit Private footerRange As Range Sub RowsToRepeatAtBottomOfPrintedPage() 'http://www.vbaexpress.com/forum/showthread.php?t=426 Dim footerHeight As Double Dim activeSheetName As String 'Set Footer range / Rows to repeat at the bottom of the page Dim aRange As String aRange = Selection.Row & ":" & Selection.Row + Selection.Rows.Count - 1 Set footerRange = Rows(aRange) 'First 21 characters of sheet name activeSheetName = Mid(ActiveSheet.Name, 1, 21) 'Copy current sheet and place it before active sheet ActiveSheet.Copy after:=Sheets(ActiveSheet.Index) 'Remove the Footer Rows from the Copy ActiveSheet.Rows(aRange).Delete Shift:=xlShiftUp 'Rename new sheet to be "Printable " and first 21 characters of original name ActiveSheet.Name = "Printable " & activeSheetName 'Set height of footer footerHeight = footerRange.Height 'Select last cell in sheet, necessary while using hpagebreaks for some reason Range("A1").SpecialCells(xlLastCell).Select 'Horizontal page break counter Dim pageBreakCounter As Long pageBreakCounter = 1 'Loop through enough times to put a footer 'On every page (the number of pages changes 'as the macro runs. Do Call addFooterAt(pageBreakCounter, footerHeight) 'Next pagebreak counter pageBreakCounter = pageBreakCounter + 1 Loop Until pageBreakCounter > ActiveSheet.HPageBreaks.Count 'Loop to next page, unless already on last page 'Hack to add footer to bottom of last page 'Create a cell with a space in it and 'insert rows before it until you have a new 'page. Then insert your footer the same way 'as above and remove the cell with the space 'so as not to print an extra blank page Dim lastRow As Integer lastRow = ActiveSheet.UsedRange.Rows.Count + 1 'Put a space in the cell 2 cells down from the 'last cell ActiveSheet.Cells(lastRow + 1, 1) = " " 'Keep adding blank rows While pageBreakCounter > ActiveSheet.HPageBreaks.Count ActiveSheet.Rows(lastRow).Insert Shift:=xlDown Wend 'Insert Last Footer Call addFooterAt(ActiveSheet.HPageBreaks.Count, footerHeight) 'Remove the spaced out cell ;-) ActiveSheet.Rows(ActiveSheet.UsedRange.Rows.Count).Delete Shift:=xlShiftUp 'Select first cell again Range("A1").Select 'Uncomment the following lines if this will be used each time the page is printed 'ActiveSheet.PrintOut 'Application.DisplayAlerts = False 'ActiveSheet.Delete 'Application.DisplayAlerts = True End Sub Private Sub addFooterAt(page As Long, footerHeight As Double) Dim rowOfPageBreak As Long Dim tempHeight As Double Dim RowHeight As Double Dim x As Long 'Set temp footer height variable to equal footer height tempHeight = footerHeight 'Set row variable to page break row number rowOfPageBreak = ActiveSheet.HPageBreaks(page).Location.Row 'For each given page, start at the last row in 'the page and start moving upwards. For each row of 'the rows encountered while moving backwards, subtract 'that rows height from the tempHeight of the footer. 'When the temp height is less than or equal to zero, 'we have moved up far enough so that if we insert the 'footer in the current location, it will appear in its 'entirety at the bottom of the page. For x = 1 To ActiveSheet.UsedRange.Rows.Count 'Subtract row from temp footer height RowHeight = Rows(rowOfPageBreak - x).Height tempHeight = tempHeight - RowHeight 'Rows(rowOfPageBreak - x).Height 'Once enough rows have been looped through to make room for footer, exit loop If tempHeight <= 0 Then Exit For Next x 'Next row 'Copy footer range footerRange.Copy 'Insert footer range at end of sheet Rows(rowOfPageBreak - x).Insert Shift:=xlDown 'Clear clipboard Application.CutCopyMode = False End Sub
Last edited by Aussiebear; 04-11-2023 at 01:29 AM. Reason: Adjusted the code tags
Looks good! If you want to be able to select the footer range at runtime, use the following code:
'Set Footer range / Rows to repeat at the bottom of the page On Error Resume Next Set footerRange = Application.InputBox(prompt:="Select range of cells to " & _ "include at the bottom of each page", Title:="Select Footer Rows", Type:=8).EntireRow If footerRange Is Nothing Then msgbox "No selection detected": Exit Sub On Error GoTo 0
Matt
Last edited by Aussiebear; 04-11-2023 at 01:29 AM. Reason: Adjusted the code tags