Determine where auto page breaks are

[kklaus]

Right now I have code that selects a particular range of cells and it copys and pastes those cells in a Word doc. Then it goes onto my next range of cells and does the same thing and so on.

The problem is that because users need to hide various rows, the length of the page changes.

I need to be able to determine where the auto page breaks are based on the page margins, then copy and paste those cells. And loop that until row 360 (last row of the sheet).

Example:
Based on the margins the auto page break is after row 53. After the user hide various rows, the auto page break becomes after row 73.

I need to find out that the last row is 73 then copy and paste rows 1-73 and paste into Word. Then I need to copy rows 74-? whatever the next page break is and so on until row 360.

Here's the code I have right now that does it by a particular range:

Dim source As Range 
Dim wdApp As Object 
Dim wdDoc As Object 

Set wdApp = CreateObject("Word.Application") 
'Add a document. 
Set wdDoc = wdApp.Documents.Add 
  
With ActiveSheet 
Set source = .Range("A289:F360").SpecialCells(xlCellTypeVisible) 
source.Copy 
'Range("A289:F360").Select 
'Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 
End With 

'Here's where I tried to name the .doc file from a cell on the sheet 
strname = ThisWorkbook.Sheets("Quote Letter").Range("E14").Value & " Quote Letter" 

With wdDoc 
    wdDoc.PageSetup.LeftMargin = "0.5" 
    wdDoc.PageSetup.RightMargin = "0.5" 
    wdDoc.PageSetup.TopMargin = "0.75" 
    wdDoc.PageSetup.BottomMargin = "0.75" 
    'Paste the source-range into the active document as a picture 
    wdApp.Selection.Range.PasteSpecial Link:=False, DataType:=3, _ 
    Placement:=wdInLine, DisplayAsIcon:=False 
    'wdApp.Selection.Range.PasteSpecial Link:=False, DataType:="Bitmap", _ 
    Placement:=wdInLine, DisplayAsIcon:=False 
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter 
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter 
End With 


With ActiveSheet 
Set source = .Range("A70:F287").SpecialCells(xlCellTypeVisible) 
source.Copy 
End With 


With wdDoc 
    wdDoc.PageSetup.LeftMargin = "0.5" 
    wdDoc.PageSetup.RightMargin = "0.5" 
    wdDoc.PageSetup.TopMargin = "0.75" 
    wdDoc.PageSetup.BottomMargin = "0.75" 
    wdApp.Selection.Range.PasteSpecial Link:=False, DataType:=3, _ 
    Placement:=wdInLine, DisplayAsIcon:=False 
    wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 
End With 
    
With ActiveSheet 
    Set source = .Range("A1:F69").SpecialCells(xlCellTypeVisible) 
    source.Copy 
End With 


With wdDoc 
    wdDoc.PageSetup.LeftMargin = "0.5" 
    wdDoc.PageSetup.RightMargin = "0.5" 
    wdDoc.PageSetup.TopMargin = "0.75" 
    wdDoc.PageSetup.BottomMargin = "0.75" 
    wdApp.Selection.Range.PasteSpecial Link:=False, DataType:=3, _ 
    Placement:=wdInLine, DisplayAsIcon:=False 
End With 
    
With wdDoc 
'Save & Close the document 
.SaveAs ThisWorkbook.Path & "\" & strname & ".doc" 
.Close 
End With 


'Close the hidden instance of Word 
wdApp.Quit 

Application.CutCopyMode = False

Any help would be great.

Thanks!

 

[macropod]

Hi kklaus,

Basically, what you need to do is to determine what the print height is for your Word page, then find out how many whole rows in the Excel worksheet will fit into that area, based on each row's height. In that sense, it doesn't matter whether the rows in Excel are visible or not. Then, when you've arrived at the point where no more rows can fit, copy that portion of the worksheet and paste it into Word.

However, there is a much simpler approach that may just deliver a suitable result:
Select the whole range in Excel that you're interested in and paste it into Word in RTF format (see under Edit|Paste Special). This will create a Word table that can span multiple pages. You can even have it linked to the worksheet, so that it will update to reflect any changes there.

Cheers