Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Pagebreaks problems - Urgent
Hi,
I have an Excel application that creates a visual design using images. As an overview the application paste images into the design sheet moving down any existings images. I find out where the next pagebreak will be to locate the image before or after a pagebreak to avoid splitting the image in the preview or when printing. When the "design" is finished it is exported to another workbook (Saved as). All the pageSetup settings are set on the new workbook's sheet that will hold the design on. In the exporting application everything works find, it finds the pagebreaks and locate the images just right. The preview or printing never splits any images. The problem: The exported sheet has different pagebreaks even they have same pageSetup properties. This means if a design is larger than one page, the images are splitted or wrongly located. You can find the code of the exportDesign sub below. I will appreciate any ideas. Carlos Public Sub ExportDesign() Application.ScreenUpdating = False Dim oExpSheet As Worksheet Dim oWorkBook As Workbook Dim oSheet As Worksheet Dim oObj As Object Set oSheet = Application.Sheets("Design") Application.ScreenUpdating = False CurWorkBook = ThisWorkbook.Name sFileFormat = ThisWorkbook.FileFormat 'Do sFileName = Application.GetSaveAsFilename(FileFilter:="Excel files (*.XLS),*.Xls") 'Loop Until sFileName < False If sFileName = sAppName Then MsgBox "You can not save the exporting file using current application's name, process canceled" Exit Sub End If If sFileName = False Then MsgBox "'Save as' process has been canceled" Exit Sub End If Set oWorkBook = Workbooks.Add If Dir(sFileName) < "" Then Set oFS = CreateObject("Scripting.FileSystemObject") oFS.DeleteFile sFileName, True End If oWorkBook.SaveAs Filename:=sFileName NewWorkbook = oWorkBook.Name Application.Workbooks(CurWorkBook).Activate oSheet.Select nPages = findPages() nheight = ActiveCell.Height Columns("A:V").Select Selection.Copy Application.Workbooks(NewWorkbook).Activate For Each oExpSheet In ActiveWorkbook.Sheets If oExpSheet.Name = "Sheet1" Then oExpSheet.Name = "Design Project" End If Next Set oExpSheet = ActiveWorkbook.Sheets("Design Project") oExpSheet.Select Columns("A:V").Select oExpSheet.Paste Range("A1", "A600").RowHeight = nheight Range("A7").RowHeight = 21 ' Saves last row nCol = Range("V1").Column oExpSheet.Cells(1, nCol).Value = nPageFormat oExpSheet.Cells(2, nCol).Value = nPages oExpSheet.Cells(1, 1).Select ActiveWindow.View = xlPageBreakPreview oExpSheet.DisplayPageBreaks = True With oExpSheet.PageSetup '.PrintArea = "$C$3:$T$" & Trim(Str(aPageRange(nPages - 1, 2) + 5)) .PrintArea = oSheet.PageSetup.PrintArea .Orientation = oSheet.PageSetup.Orientation .PaperSize = oSheet.PageSetup.PaperSize .FitToPagesWide = 1 .FitToPagesTall = nPages .LeftMargin = oSheet.PageSetup.LeftMargin .RightMargin = oSheet.PageSetup.RightMargin .TopMargin = oSheet.PageSetup.TopMargin .BottomMargin = oSheet.PageSetup.BottomMargin .Zoom = oSheet.PageSetup.Zoom .PrintGridlines = False End With oExpSheet.Cells(3, nCol).Value = aPageRange(nPages - 1, 2) + 5 lFreezePanes = ActiveWindow.FreezePanes ActiveWindow.FreezePanes = False With Application .CutCopyMode = False .Workbooks(NewWorkbook).Save .Workbooks(NewWorkbook).Close .Workbooks(CurWorkBook).Activate .ActiveSheet.Cells(1, 1).Select .ScreenUpdating = True End With MsgBox "The exported design file has been saved to '" & sFileName ActiveWindow.FreezePanes = lFreezePanes End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
URGENT- Form design and field tab-order problems | Excel Discussion (Misc queries) | |||
urgent ......problems on group | Excel Worksheet Functions | |||
List Box Problems - Urgent!! | Excel Programming | |||
pagebreaks | Excel Programming | |||
Excel pagebreaks | Excel Programming |