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
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