VBA code question - creating Word document and pasting all charts into this

[gmcgough600]

Hi, looking for some help. I have a macro that copies graphs over from Excel to a new Word document but recently this started producing Word documents in Letter size, not sure why this has happened as previously I think they were A4 previously. Just need some code to change the Word paper size to A4, I've tried the code below but this gives an error:

"Run-time error '5889':

Requested PaperSize is not available on the currently selected printer."

objDoc.PageSetup.PaperSize = wdPaperA4

Here's more of the code for context (sorry about the length of this!):

Dim objWord As Object
Dim objDoc As Object
Dim iCht, number_of_columns, copy_chart_sheets, copy_worksheet_charts As Integer
Dim Msg As String
Dim cm_to_inch As Double
cm_to_inch = 0.393701

    '====================
    'Allow for an observations box or not
    number_of_columns = 1
    selection_event = MsgBox("Would you like to include a box for Observations?", vbYesNo, " Contact Server?")
    Select Case selection_event
    Case 6 ' Yes
        number_of_columns = 2
    End Select
    '====================
    
    '====================
    'Chart size input
    Dim chart_size As Double
        chart_size_cm = 13
    If number_of_columns = 1 Then
        chart_size_cm = InputBox("Please select the desired height of the charts (cm) in Word.", "Chart height?", 15)
        Else
        chart_size_cm = InputBox("Please select the desired height of the charts (cm) in Word.", "Chart height?", 13)
    End If
    If Not (IsNumeric(chart_size_cm)) Then
        MsgBox "Please enter a number!", vbOKOnly + vbExclamation, "Not a Number"
    End If
    '====================
    
    '====================
    'Add captions or not
    captions = 0
    selection_event = MsgBox("Would you like to include captions?", vbYesNo, "Captions?")
    Select Case selection_event
    Case 6 ' Yes
        captions = 1
    End Select
    '====================
    
    '====================
    'Ask for either chart sheets or charts that are objects in worksheets
    copy_chart_sheets = 0
    selection_event = MsgBox("You can copy charts in chart sheets or those embedded in worksheets. Would you like to copy charts in chart sheets?", vbYesNo, " Which charts?")
    Select Case selection_event
    Case 6 ' 6 means Yes! (and 7 means No)
        copy_chart_sheets = 1
    End Select
    copy_worksheet_charts = 0
    selection_event = MsgBox("Would you like to copy charts embedded in worksheets?", vbYesNo, " Which charts?")
    Select Case selection_event
    Case 6 ' 6 means Yes! (and 7 means No)
        copy_worksheet_charts = 1
    End Select
    '====================

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add

' View the word document in development
objWord.Visible = True
' Required orientation of landscape
With objDoc
    .PageSetup.Orientation = 1
End With

If copy_chart_sheets = 1 Then
    '====================
    For Each oChart In ActiveWorkbook.Charts
    
        '====================
        ' Copy the chart
        ' copy chart as a picture
        oChart.CopyPicture _
            Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        '====================
    
        '====================
        'Select the last paragraph, make it the current range to add a new table
        Set aRange = objDoc.Paragraphs.Last.Range
        Set objTbl = objDoc.tables.Add(Range:=aRange, NumRows:=1, NumColumns:=number_of_columns)
        '====================
    
        '====================
        ' Set default properties of table
    With objTbl
            .AllowAutoFit = True
        End With
        '====================
    
        '====================
        ' Allow for formatting of the observation box
        If number_of_columns > 1 Then
            ' Select the observations section and give it a border
            Set observations = objTbl.Cell(1, 2)
            ' Attempt to set the borders of the table
            ' This is not working, I currently don't understand why
            observations.Borders.Enable = True
            For Each b In observations.Borders
                b.Color = RGB(64, 64, 64)
            Next b
        End If
        '====================
    
    
        '====================
        ' Select the paste target and paste the chart
        ' Select the first cell of the table
        Set paste_target = objTbl.Cell(1, 1).Range
        ' Paste the copied chart
        paste_target.PasteSpecial Placement:=wdInLine
        ' Select the copied chart and resize
        objDoc.InlineShapes(objDoc.InlineShapes.Count).Height = chart_size_cm * cm_to_inch * 72
        ' Add caption
        If captions = 1 Then
            objDoc.Paragraphs.Last.Range.InsertCaption Label:="Figure", _
            Title:=": Replace with content", Position:=wdCaptionPositionBelow
        End If
        ' Add a page break
        objDoc.Paragraphs.Last.Range.InsertBreak
        '====================

    Next oChart
    '====================
End If

If copy_worksheet_charts = 1 Then
    '====================
    ' Require every chart on a new page
    Dim sht As Worksheet
    Dim CurrentSheet As Worksheet
    Dim cht As ChartObject
    
    For Each sht In ActiveWorkbook.Worksheets
        For Each cht In sht.ChartObjects
            '====================
            ' Copy the chart
            ' copy chart as a picture
            cht.CopyPicture
            '====================
            
            '====================
            'Select the last paragraph, make it the current range to add a new table
            Set aRange = objDoc.Paragraphs.Last.Range
            Set objTbl = objDoc.tables.Add(Range:=aRange, NumRows:=1, NumColumns:=number_of_columns)
            '====================
            
            '====================
            ' Set default properties of table
            With objTbl
                .AllowAutoFit = True
            End With
            '====================
        
            '====================
            ' Allow for formatting of the observation box
            If number_of_columns > 1 Then
                ' Select the observations section and give it a border
                Set observations = objTbl.Cell(1, 2)
                ' Attempt to set the borders of the table
                ' This is not working, I currently don't understand why
                observations.Borders.Enable = True
                For Each b In observations.Borders
                    b.Color = RGB(64, 64, 64)
                Next b
            End If
            '====================
            
            
            '====================
            ' Select the paste target adn paste the chart
            ' Select the first cell of the table
            Set paste_target = objTbl.Cell(1, 1).Range
            ' Paste the copied chart
            paste_target.PasteSpecial Placement:=wdInLine
            ' Select the copied chart and resize
            objDoc.InlineShapes(objDoc.InlineShapes.Count).Height = chart_size_cm * cm_to_inch * 72
            ' Add caption (modified 09/04/2019)
            If captions = 1 Then
                objDoc.Paragraphs.Last.Range.InsertCaption Label:="Figure", _
                Title:=": Replace with content", Position:=wdCaptionPositionBelow
            End If
            ' Add a page break
            objDoc.Paragraphs.Last.Range.InsertBreak
            '====================
            
        Next cht
    Next sht
End If

'Change page size to A4
objDoc.PageSetup.PaperSize = wdPaperA4

Set objDoc = Nothing
Set objWord = Nothing
Set objTbl = Nothing
Set paste_target = Nothing

Thanks!

 

[sijpie]

You are not the only person with this problem:

Requested PaperSize is not available on the currently selected printer

I would like to copy some excel data in to a word document using VBA The excel data is build for print area A3. After creating a word document, I am trying to set up paper size for new word docume...

stackoverflow.com

Ask Question Newest - DVHU Developers Questions

Ask Question Newest | Hot Network Questions,javascript.java.C#.python.php.android.jquery.html.C++.cssQuestions

www.dvhu.com

That last one (although for Excel, not Word) points to a possible cause of the problem, in the length of text in the footer.

What happens in your code if you leave out everything apart from pasting say one graph? Then slowly build up again until the error occurs.