| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add line in existing macro to use template
I have a macro that splits one sheet with many pages into individual files by
page numbers using the horizontal page break. It works perfectly. However, I need it to either A - include the header (and margins) from the original file when saving to the new file or B - use a template for the new files. I have tried to use the repeat rows from the first page but that makes a big mess in the new file. I have copied the macro below. Thanks for the help. Amy Sub SplitPages() Dim horzPBArray() Dim curWks As Worksheet Dim newWks As Worksheet Dim TopRow As Long Dim i As Long Set curWks = ActiveSheet curWks.DisplayPageBreaks = False ThisWorkbook.Names.Add Name:="hzPB", RefersToR1C1:="=GET.DOCUMENT(64,""" & ActiveSheet.Name & """)" ThisWorkbook.Names.Add Name:="vPB", RefersToR1C1:="=GET.DOCUMENT(65,""" & ActiveSheet.Name & """)" i = 1 While Not IsError(Evaluate("Index(hzPB," & i & ")")) ReDim Preserve horzPBArray(1 To i) horzPBArray(i) = Evaluate("Index(hzPB," & i & ")") i = i + 1 Wend ReDim Preserve horzPBArray(1 To i - 1) Set newWks = Workbooks.Add(1).Worksheets(1) TopRow = 1 For i = LBound(horzPBArray) To UBound(horzPBArray) newWks.Cells.Clear Columns("H:H").ColumnWidth = 13.29 curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy Destination:=newWks.Range("a1") newWks.Parent.SaveAs Filename:="S:\Amy\Invoices\test\" & "Page" & i, FileFormat:=xlWorkbookNormal TopRow = horzPBArray(i) Next i newWks.Parent.Close SaveChanges:=False End Sub |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Add line in existing macro to use template
My impatience got the best of me... This group is so empowering! Just in case
anyone else could use the info, I have posted back what I figured out to get everything to work! Columns("H:H").ColumnWidth = 13.29 Columns("J:J").ColumnWidth = 4.5 curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy Destination:=newWks.Range("a14") newWks.PageSetup.LeftHeaderPicture.Filename = "S:\Logo Files\SHINElogoMed.jpg" newWks.PageSetup.LeftHeader = "&G" newWks.PageSetup.TopMargin = Application.InchesToPoints(0.08) newWks.PageSetup.HeaderMargin = Application.InchesToPoints(0.08) newWks.PageSetup.BottomMargin = Application.InchesToPoints(0.5) newWks.PageSetup.FooterMargin = Application.InchesToPoints(0.5) newWks.PageSetup.LeftMargin = Application.InchesToPoints(1) newWks.PageSetup.RightMargin = Application.InchesToPoints(0.5) newWks.PageSetup.Zoom = 95 "Amy" wrote: I have a macro that splits one sheet with many pages into individual files by page numbers using the horizontal page break. It works perfectly. However, I need it to either A - include the header (and margins) from the original file when saving to the new file or B - use a template for the new files. I have tried to use the repeat rows from the first page but that makes a big mess in the new file. I have copied the macro below. Thanks for the help. Amy Sub SplitPages() Dim horzPBArray() Dim curWks As Worksheet Dim newWks As Worksheet Dim TopRow As Long Dim i As Long Set curWks = ActiveSheet curWks.DisplayPageBreaks = False ThisWorkbook.Names.Add Name:="hzPB", RefersToR1C1:="=GET.DOCUMENT(64,""" & ActiveSheet.Name & """)" ThisWorkbook.Names.Add Name:="vPB", RefersToR1C1:="=GET.DOCUMENT(65,""" & ActiveSheet.Name & """)" i = 1 While Not IsError(Evaluate("Index(hzPB," & i & ")")) ReDim Preserve horzPBArray(1 To i) horzPBArray(i) = Evaluate("Index(hzPB," & i & ")") i = i + 1 Wend ReDim Preserve horzPBArray(1 To i - 1) Set newWks = Workbooks.Add(1).Worksheets(1) TopRow = 1 For i = LBound(horzPBArray) To UBound(horzPBArray) newWks.Cells.Clear Columns("H:H").ColumnWidth = 13.29 curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy Destination:=newWks.Range("a1") newWks.Parent.SaveAs Filename:="S:\Amy\Invoices\test\" & "Page" & i, FileFormat:=xlWorkbookNormal TopRow = horzPBArray(i) Next i newWks.Parent.Close SaveChanges:=False End Sub |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Add line in existing macro to use template
Just in case anyone can use the information, I figured out exactly what I
needed! Columns("H:H").ColumnWidth = 13.29 Columns("J:J").ColumnWidth = 4.5 curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy Destination:=newWks.Range("a14") newWks.PageSetup.LeftHeaderPicture.Filename = "S:\Logo Files\SHINElogoMed.jpg" newWks.PageSetup.LeftHeader = "&G" newWks.PageSetup.TopMargin = Application.InchesToPoints(0.08) newWks.PageSetup.HeaderMargin = Application.InchesToPoints(0.08) newWks.PageSetup.BottomMargin = Application.InchesToPoints(0.5) newWks.PageSetup.FooterMargin = Application.InchesToPoints(0.5) newWks.PageSetup.LeftMargin = Application.InchesToPoints(1) newWks.PageSetup.RightMargin = Application.InchesToPoints(0.5) newWks.PageSetup.Zoom = 95 "Amy" wrote: I have a macro that splits one sheet with many pages into individual files by page numbers using the horizontal page break. It works perfectly. However, I need it to either A - include the header (and margins) from the original file when saving to the new file or B - use a template for the new files. I have tried to use the repeat rows from the first page but that makes a big mess in the new file. I have copied the macro below. Thanks for the help. Amy Sub SplitPages() Dim horzPBArray() Dim curWks As Worksheet Dim newWks As Worksheet Dim TopRow As Long Dim i As Long Set curWks = ActiveSheet curWks.DisplayPageBreaks = False ThisWorkbook.Names.Add Name:="hzPB", RefersToR1C1:="=GET.DOCUMENT(64,""" & ActiveSheet.Name & """)" ThisWorkbook.Names.Add Name:="vPB", RefersToR1C1:="=GET.DOCUMENT(65,""" & ActiveSheet.Name & """)" i = 1 While Not IsError(Evaluate("Index(hzPB," & i & ")")) ReDim Preserve horzPBArray(1 To i) horzPBArray(i) = Evaluate("Index(hzPB," & i & ")") i = i + 1 Wend ReDim Preserve horzPBArray(1 To i - 1) Set newWks = Workbooks.Add(1).Worksheets(1) TopRow = 1 For i = LBound(horzPBArray) To UBound(horzPBArray) newWks.Cells.Clear Columns("H:H").ColumnWidth = 13.29 curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy Destination:=newWks.Range("a1") newWks.Parent.SaveAs Filename:="S:\Amy\Invoices\test\" & "Page" & i, FileFormat:=xlWorkbookNormal TopRow = horzPBArray(i) Next i newWks.Parent.Close SaveChanges:=False End Sub |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Add line in existing macro to use template
Here is what I finally figured out... just in case anyone else can use the
info. Columns("H:H").ColumnWidth = 13.29 Columns("J:J").ColumnWidth = 4.5 curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy Destination:=newWks.Range("a14") newWks.PageSetup.LeftHeaderPicture.Filename = "S:\Logo Files\SHINElogoMed.jpg" newWks.PageSetup.LeftHeader = "&G" newWks.PageSetup.TopMargin = Application.InchesToPoints(0.08) newWks.PageSetup.HeaderMargin = Application.InchesToPoints(0.08) newWks.PageSetup.BottomMargin = Application.InchesToPoints(0.5) newWks.PageSetup.FooterMargin = Application.InchesToPoints(0.5) newWks.PageSetup.LeftMargin = Application.InchesToPoints(1) newWks.PageSetup.RightMargin = Application.InchesToPoints(0.5) newWks.PageSetup.Zoom = 95 "Amy" wrote: I have a macro that splits one sheet with many pages into individual files by page numbers using the horizontal page break. It works perfectly. However, I need it to either A - include the header (and margins) from the original file when saving to the new file or B - use a template for the new files. I have tried to use the repeat rows from the first page but that makes a big mess in the new file. I have copied the macro below. Thanks for the help. Amy Sub SplitPages() Dim horzPBArray() Dim curWks As Worksheet Dim newWks As Worksheet Dim TopRow As Long Dim i As Long Set curWks = ActiveSheet curWks.DisplayPageBreaks = False ThisWorkbook.Names.Add Name:="hzPB", RefersToR1C1:="=GET.DOCUMENT(64,""" & ActiveSheet.Name & """)" ThisWorkbook.Names.Add Name:="vPB", RefersToR1C1:="=GET.DOCUMENT(65,""" & ActiveSheet.Name & """)" i = 1 While Not IsError(Evaluate("Index(hzPB," & i & ")")) ReDim Preserve horzPBArray(1 To i) horzPBArray(i) = Evaluate("Index(hzPB," & i & ")") i = i + 1 Wend ReDim Preserve horzPBArray(1 To i - 1) Set newWks = Workbooks.Add(1).Worksheets(1) TopRow = 1 For i = LBound(horzPBArray) To UBound(horzPBArray) newWks.Cells.Clear Columns("H:H").ColumnWidth = 13.29 curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy Destination:=newWks.Range("a1") newWks.Parent.SaveAs Filename:="S:\Amy\Invoices\test\" & "Page" & i, FileFormat:=xlWorkbookNormal TopRow = horzPBArray(i) Next i newWks.Parent.Close SaveChanges:=False End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Adding a Second and Third Line to an Existing Stacked Bar/Line Cha | Charts and Charting in Excel | |||
| average Line created in an existing line graph- based on one cell | Charts and Charting in Excel | |||
| Create Worksheet From Values in Existing Cells Using Existing Worksheet as Template. | Excel Programming | |||
| Template changes to existing workbooks | Excel Worksheet Functions | |||
| Running a macro to edit one line in existing VBA | Excel Programming | |||
Linear Mode
