PDA

View Full Version : Solved: Row to repeat at bottom



YasserKhalil
05-12-2010, 04:12 PM
hello everyone
I noticed that there is an option of repeating rows at top in excel
but there is no option for repeating rows at bottom
I tried footer but it's restricted and I need to select certain rows to be printed at the end of each page
I hope to find the solution here
Excel Lover

austenr
05-12-2010, 04:58 PM
Try this. Modify the worksheet and range to suit.

Sub MyFooter()
Dim StrFtr As String, Rng As Range, Sh As Worksheet, c As Range
Set Sh = Worksheets("Sheet5")
Set Rng = Sh.Range("A55:G55")

For Each c In Rng
StrFtr = StrFtr & c & " "
Next c

ActiveSheet.PageSetup.LeftFooter = StrFtr
End Sub

YasserKhalil
05-13-2010, 08:39 AM
Good code
But it doesn't work as I do ...
I want to print three rows at the bottom of each page as the option of top rows
Please I'm in a bad need of this issue
Excel Lover

GTO
05-13-2010, 01:20 PM
Hi Yasser,

Could you attach an example workbook? Fake data is fine as long as the layout and type are consistent with the original. I would suggest several 'pages' of data on the first sheet, and a could of other sheets that show what the print job should look like.

Mark

mdmackillop
05-13-2010, 01:46 PM
There is no "easy" way to do this. If you ensure row heights are consistent, you can paste in a footer every 40 lines or so. If WrapText changes row heights, things get much more complicated.

hardlife
05-13-2010, 03:47 PM
Hi it is probably not possible in older office,

in 2007 You can try attachment :hi:

YasserKhalil
05-14-2010, 12:53 AM
Perfect HardLife
with you Life won't be hard..no it'll be easy
thank you very much for your help
I was in a bad need of such a perfect code
wait for more creations from you!!
Excel Lover

hardlife
05-14-2010, 03:58 AM
Hi YasserKhalil, me is happy it is working :hi:

hardlife
05-14-2010, 06:44 AM
:hi:

asgarymo
06-21-2012, 06:46 AM
There is no "easy" way to do this. If you ensure row heights are consistent, you can paste in a footer every 40 lines or so. If WrapText changes row heights, things get much more complicated.


Helo mate,

I found this post when I faced the same problem with excel. can you possibly send me that sample excel file to repeat rows at the bottom of page?

cheers

b_keyvani
06-08-2015, 02:21 AM
Dear hardlife
Would you please post attachment for the solution again
I can not find it within this thread
Thanks a lot

hardlife
06-08-2015, 08:52 AM
:hi:


'http://www.vbaexpress.com/forum/showthread.php?t=10902

'01-11-2007, 08:09 AM
'tstom

'Objects that this code can save as a file.
'Charts
'ChartObjects
'OLEObjects
'Ranges
'Shapes
'Images (Pictures)

'Search MSDN for much of this code...

Option Explicit

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

Function PictureFromObject(Target As Object) As IPictureDisp
Dim hPtr As Long, PicType As Long, hCopy As Long

Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1
Const PICTYPE_ENHMETAFILE = 4
Target.CopyPicture
PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE)
If IsClipboardFormatAvailable(PicType) <> 0 Then
If OpenClipboard(0) > 0 Then
hPtr = GetClipboardData(PicType)
If PicType = CF_BITMAP Then
hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
Else
hCopy = CopyEnhMetaFile(hPtr, vbNullString)
End If
CloseClipboard
If hPtr <> 0 Then
Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp

With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With

With uPicInfo
.Size = Len(uPicInfo)
.Type = IIf(PicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)
.hPic = hCopy
End With

OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
Set PictureFromObject = IPic
End If
End If
End If
End Function

'Example usage:
'Sheet1 must contain the objectd listed in the procedure below
'in order for the code to succeed...

Sub Example()
'save an image or shape
'SavePicture PictureFromObject(Sheet1.Pictures("Picture 1")), "C:\Picture 1.bmp"
'save a shape
'SavePicture PictureFromObject(Sheet1.Shapes("WordArt 1")), "C:\WordArt 1.gif"
'save a range
SavePicture PictureFromObject(List1.Range("A119:I120")), "C:\RangeA1_B4.jpg"
End Sub


Sub PRINT_BOTTOM_TO_FOOTER()

'MsgBox "working in office 2007"

SavePicture PictureFromObject(ActiveSheet.Range("PRINT_BOTTOM")), _
ThisWorkbook.Path & Application.PathSeparator & "PRINT_BOTTOM.jpg"

'ActiveSheet.PageSetup.LeftFooterPicture.Filename = "C:\Test\PRINT_BOTTOM.jpg"
ActiveSheet.PageSetup.LeftFooterPicture.Filename _
= ThisWorkbook.Path & Application.PathSeparator & "PRINT_BOTTOM.jpg"

With ActiveSheet.PageSetup
.LeftFooter = "&G"
End With

Kill ThisWorkbook.Path & Application.PathSeparator & "PRINT_BOTTOM.jpg"

End Sub

Sub print_all()
ActiveSheet.PageSetup.PrintArea = ""
End Sub

Sub print_specified_range()
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$118"
End Sub

trusban
04-14-2017, 06:39 AM
Thanks, man! This insane thing works awesome!

hardlife
04-14-2017, 07:33 AM
sunny day 18933