PDA

View Full Version : [SOLVED] page break code



babycody
03-16-2005, 08:53 PM
How would I go about reseting page break, and then move the verticle page break to the right stopping between column F & G. I only want to print data in column A thru F to clarify. The problem I am having is that when this is printed it winds up on three pages instead of one. I know this is because of my page breaks, but I want to safe guard against this happening to anyone else. The code I am using so far is posted below just incase you need to know anything. Thanks everyone for any help.


Private Sub CommandButton1_Click()
' this macro saves the active sheet to a cell value as seen below (5, 10) = Cell J5
'Variable declaration
Dim oApp As Object
Dim oMail As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim FileName As String
'Turns off screen updating
Application.ScreenUpdating = False
'adds the date to cell B3
With Range("B3")
.Value = Date
.NumberFormat = "mm/dd/yyyy"
End With
'adds the date to cell J4
With Range("J4")
.Value = Date
.NumberFormat = "mmm-dd-yyyy"
End With
Range("A1:F487").Copy
Sheets.Add
Set ws = ActiveSheet
ws.Range("A1").PasteSpecial Paste:=xlPasteAll
ws.Columns.AutoFit
ws.Rows.AutoFit
ws.Columns("E:E").ColumnWidth = 21
Range("A1:F457").PrintOut
'Makes a copy of the active sheet and save it to
'a folder
Application.CutCopyMode = False
ws.Copy
'Adjust column width of merged cells to compensate for ws.Columns.AutoFit
Columns("E:E").ColumnWidth = 21
Set wb = ActiveWorkbook
'this macro saves the active sheet to a cell value as seen below (5, 10) = Cell J5
FileName = Cells(5, 10).Value & " .xls"
On Error Resume Next
Kill "C:\Documents and Settings\bgrant\Desktop\FB ADJUSTMENT\" & FileName
On Error GoTo 0
wb.SaveAs FileName:="C:\Documents and Settings\bgrant\Desktop\FB ADJUSTMENT\" & FileName
'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a To recipient
.To = "wpark@penningtonseed.com;jthomason@penningtonseed.com;fowens@penningtonseed .com;rcosby@penningtonseed.com"
'Uncomment the line below to hard code a CC recipient
.CC = "hbauer@penningtonseed.com;mneugebauer@penningtonseed.com;tchandler@penningt onseed.com;lhawk@penningtonseed.com"
'Uncomment the line below to hard code a Bnn recipient
'.Bcc = "someone@somewhere.com"
'Uncomment the line below to hard code a subject
.Subject = " Please review " & Cells(5, 10).Value
.Body = "I have attached to this email " & Cells(5, 10).Value
.Attachments.Add wb.FullName
.Display
ActiveWorkbook.Close
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End With
'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub

Jacob Hilderbrand
03-16-2005, 09:05 PM
Try this:



ActiveSheet.ResetAllPageBreaks
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Range("G1")

babycody
03-16-2005, 09:25 PM
I put the code in, and it did reset all page breaks. Unfortunately it didn't move the verticle page break over. Here is the code as I used it.


Private Sub CommandButton1_Click()
' this macro saves the active sheet to a cell value as seen below (5, 10) = Cell J5
'Variable declaration
Dim oApp As Object
Dim oMail As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim FileName As String
'Turns off screen updating
Application.ScreenUpdating = False
'adds the date to cell B3
With Range("B3")
.Value = Date
.NumberFormat = "mm/dd/yyyy"
End With
'adds the date to cell J4
With Range("J4")
.Value = Date
.NumberFormat = "mmm-dd-yyyy"
End With
ActiveSheet.ResetAllPageBreaks
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Range("G1")
Range("A1:F487").Copy
Sheets.Add
Set ws = ActiveSheet
ws.Range("A1").PasteSpecial Paste:=xlPasteAll
ws.Columns.AutoFit
ws.Rows.AutoFit
ws.Columns("E:E").ColumnWidth = 21
Range("A1:F457").PrintOut
'Makes a copy of the active sheet and save it to
'a folder
Application.CutCopyMode = False
ws.Copy
'Adjust column width of merged cells to compensate for ws.Columns.AutoFit
Columns("E:E").ColumnWidth = 21
Set wb = ActiveWorkbook
'this macro saves the active sheet to a cell value as seen below (5, 10) = Cell J5
FileName = Cells(5, 10).Value & " .xls"
On Error Resume Next
Kill "C:\Documents and Settings\bgrant\Desktop\FB ADJUSTMENT\" & FileName
On Error GoTo 0
wb.SaveAs FileName:="C:\Documents and Settings\bgrant\Desktop\FB ADJUSTMENT\" & FileName
'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a To recipient
.To = "wpark@penningtonseed.com;jthomason@penningtonseed.com;fowens@penningtonseed .com;rcosby@penningtonseed.com"
'Uncomment the line below to hard code a CC recipient
.CC = "hbauer@penningtonseed.com;mneugebauer@penningtonseed.com;tchandler@penningt onseed.com;lhawk@penningtonseed.com"
'Uncomment the line below to hard code a Bnn recipient
'.Bcc = "someone@somewhere.com"
'Uncomment the line below to hard code a subject
.Subject = " Please review " & Cells(5, 10).Value
.Body = "I have attached to this email " & Cells(5, 10).Value
.Attachments.Add wb.FullName
.Display
ActiveWorkbook.Close
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End With
'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub


I think that I was misunderstood. I realized what this code ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Range("G1") was meant to do after a couple of quick tries with it. I don't need a page break added. I need any verticle page breaks before column G moved over to rest between F&G. I am sorry if I wasn't clear about that. Reseting the page breaks still leaves me with a verticle page break between D&E.

Jacob Hilderbrand
03-16-2005, 09:26 PM
Did it put the page break between F and G? If there is another page break before those then you need to change the margins to make the additional area fit.

babycody
03-16-2005, 09:58 PM
You are right DRJ. Maybe I have tried to go about this the wrong way. How would I use set print area? The range would be between A1 and the last filled cell between column A&F. On another note how can I change the margins with code?

Jacob Hilderbrand
03-16-2005, 10:28 PM
You can set the print area like this:


Dim LastColumn As Long
Dim LastRow As Long
LastRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
ActiveSheet.PageSetup.PrintArea = "A1:" & Cells(LastRow, LastColumn).Address

You can change the margins like this:


With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
End With

babycody
03-16-2005, 11:25 PM
I really like the margin code you posted. I think I will like the row and column code also. I do have information entered into the columns after column F. However I don't want this to be printed. With your column code above wouldn't it find the last column with code in it and print it as well. I would like to have control over where the last column would be. I could possibly add many more rows to my sheet, but the columns I want to print will never change to add more in the future. Thank you for what you have posted.

Jacob Hilderbrand
03-16-2005, 11:31 PM
Just change this part:


Cells.Find(
To something like this:

Range("A:F").Find(