Format eines neuen Workbooks
25.05.2006 01:24:43
Ramplow
habe hier ein kleines Problem. Habe eine vorhandene Exelliste, die ich in einem neuem Workbook durch ein Makro speicher. Ich moechte allerdings auch das Format aender, das heisst die Zeilenhoehe und die Zeilenbreite (ist immer unterschiedlich). Es klappt eben alles bis auf das formatieren. Waere supe, wenn jemand eine Idee hat oder mir einfachen sagen kann, wo mein Fehler liegt.
Das ist das Problem Makro
Private Sub CommandButton4_Click()
Dim a As String
a = Worksheets("Advisor").Range("C3").Value
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"H:\insurance\Lists\TermBooks\" & a & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Workbooks("abc.xls").Activate
Range("A2:I250").Select
Selection.Copy
Workbooks(a & ".xls").Activate
Worksheets("Sheet1").Range("A1").Select
ActiveSheet.Paste
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "&D"
.CenterHeader = "&""Arial,Bold""&14Term Book of Business"
.RightHeader = "Page &P of &N"
.LeftFooter = "&F"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 80
End With
Worksheets("Sheet1").Rows("4:500").Select
Worksheets("Sheet1").Selection.RowHeight = 16
Worksheets("Sheet1").Rows("3:3").Select
Worksheets("Sheet1").Selection.RowHeight = 9.75
Worksheets("Sheet1").Rows("2:2").Select
Worksheets("Sheet1").Selection.RowHeight = 19.5
Worksheets("Sheet1").Rows("1:1").Select
Worksheets("Sheet1").Selection.RowHeight = 29.5
Worksheets("Sheet1").Range("A:A,E:E").Select
Worksheets("Sheet1").Range("E1").Activate
Worksheets("Sheet1").Selection.ColumnWidth = 10.43
Worksheets("Sheet1").Columns("B:B").Select
Worksheets("Sheet1").Selection.ColumnWidth = 20
Worksheets("Sheet1").Columns("C:C").Select
Worksheets("Sheet1").Selection.ColumnWidth = 25
Worksheets("Sheet1").Columns("D:D").Select
Worksheets("Sheet1").Selection.ColumnWidth = 13
Worksheets("Sheet1").Columns("F:F").Select
Worksheets("Sheet1").Selection.ColumnWidth = 12
Worksheets("Sheet1").Columns("G:G").Select
Worksheets("Sheet1").Selection.ColumnWidth = 14.57
Worksheets("Sheet1").Columns("H:H").Select
Worksheets("Sheet1").Selection.ColumnWidth = 12.14
Worksheets("Sheet1").Columns("I:I").Select
Worksheets("Sheet1").Selection.ColumnWidth = 15.29
Worksheets("Sheet1").Range("H2").Select
Worksheets("Sheet1").ActiveCell.FormulaR1C1 = "=SUM(R[3]C[1]:R[164]C[1])"
Worksheets("Sheet1").Range("H3").Select
Worksheets("Sheet1").ActiveWindow.ScrollRow = 1
Worksheets("Sheet1").Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close
Workbooks("abc.xls").Activate
Range("A6").Select
End Sub
Danke