View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Nimbus55 Nimbus55 is offline
external usenet poster
 
Posts: 11
Default How do I format a sheet using a copy macro?

I am trying to save one sheet in a workbook as a separate file using the
following code, but I am having a couple of problems...a graphic object is
not being copied and the formating is not working...it's getting cut off
along the right side, although it prints perfectly in the context of the main
book.

Sub cmdSaveSignOff()
'------------------------------------------------------------------------------------
' Save the Score Sheet alone to another file
'------------------------------------------------------------------------------------

' Go to the score sheet
Sheets("Sign Off ").Select

' Confirm user really wants to do this
prompt = "This command will copy the Sign Off Sheet into a new Excel
file" _
+ " without any of the other sheets." _
+ vbCrLf + vbCrLf _
+ "Please note the following:" _
+ vbCrLf + vbCrLf _
+ "1/ The new file will contain only the text of the Sign Off
Sheet - no" _
+ " calculations/automation will be performed." _
+ vbCrLf _
+ "2/ Subsequent changes to this Sign Off Sheet will NOT be
automatically copied " _
+ "to the new file. You will have to save it again." _
+ vbCrLf + vbCrLf _
+ "Do you want to continue?"
Title = "Save Sign Off"
Buttons = vbYesNo + vbDefaultButton2 + vbQuestion
Confirm = MsgBox(prompt, Buttons, Title)
If Confirm = vbNo Then
MsgBox "Sign Off Not Saved!", vbExclamation, Title
Exit Sub
End If

' For speed, turn off automatic calculation and screen updating
Call subAutoCalculation(False)
Application.ScreenUpdating = False

' Grab the current workbook name for later
aWB = ActiveWorkbook.Name

' Copy the data
Cells.Select
Selection.Copy
Range("C3").Select ' put cursor back

' Create a new workbook
Workbooks.Add

' Paste the data as "values"
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Paste the formatting
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Copy the color palette
ActiveWorkbook.Colors = Workbooks(aWB).Colors

' Do proper page setup
Application.StatusBar = "Page setup..."
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.75)
.FooterMargin = Application.InchesToPoints(0.75)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperRegular
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 99
End With

' Reset selection
Range("C3").Select

' Save the file
Application.Dialogs(xlDialogSaveAs).Show
If ActiveWorkbook.Path = "" Then ' if the new workbook has no
path then
prompt = "Sign Off Sheet Not Saved!" ' the user cancelled out of
the "Save As" dialog
Else
NewFile = ActiveWorkbook.Path + "\" + ActiveWorkbook.Name
prompt = "Sign Off Sheet saved as " + NewFile
End If
MsgBox prompt, vbExclamation, Title ' display results

' Close the new file (without saving since we just saved it or the user
canceled out
' of the "Save As" dialog)
ActiveWorkbook.Close (False)

' Start updating the screen again
Application.ScreenUpdating = True

' Turn automatic calculation back on
Call subAutoCalculation(True)

End Sub