gmcgough600
New Member
- Joined
- Nov 21, 2017
- Messages
- 33
- Office Version
- 365
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."
Here's more of the code for context (sorry about the length of this!):
Thanks!
"Run-time error '5889':
Requested PaperSize is not available on the currently selected printer."
VBA Code:
objDoc.PageSetup.PaperSize = wdPaperA4
Here's more of the code for context (sorry about the length of this!):
Code:
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!