Copy from Excel, Paste into Word Error

[DouglasWicker]

Morning All,

I have an issue with he code below;

The code selects objects from my excel workbook and pastes it into a new word document fine, however I get an error when adjusting the margins.

The error I get is a Run-time error '462': - The remote server machine does not exist or is unavailable.

It is also worth mentioning that the code works flawlessly when running from the VBA window, just doesn't work when using the macro button.

Any ideas??

ActiveSheet.Shapes.Range(Array("Group 329", "Group 302", "Group 320", _        "Group 293", "Group 284", "TextBox 241", "TextBox 240", "TextBox 242", _
        "TextBox 243", "Group 275", "TextBox 244", "TextBox 245", "Group 257", _
        "Group 266", "TextBox 246", "TextBox 239", "Group 75", "TextBox 238")).Select
    Selection.Copy
    
   
    
    Dim wdApp As Object
    
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        On Error GoTo 0
    
    If wdApp Is Nothing Then
        Set wdApp = CreateObject(Class:="Word.Application")     'INITIALIZE THE OBJECT.
        wdApp.Visible = True      'OPEN THE WORD FILE.
        wdApp.Documents.Add       'Add new Page
        wdApp.Activate            'Activate Page
        
        wdApp.Selection.Paste     'Paste Report
        
      
        'set Margins
        wdApp.Selection.PageSetup.TopMargin = CentimetersToPoints(2.25)
        
        wdApp.Selection.PageSetup.BottomMargin = CentimetersToPoints(0)
        
        wdApp.Selection.PageSetup.RightMargin = CentimetersToPoints(0)
        
        wdApp.Selection.PageSetup.LeftMargin = CentimetersToPoints(1.4)
        
    Else
        MsgBox "No word documents can be open to generate a report."
    End If
                
        'Clean up the Object when Finished
        Set wdApp = Nothing

 

[Macropod]

Try:

Sub Test()
Dim wdApp As Object, wdDoc As Object

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
  Set wdApp = CreateObject(Class:="Word.Application")     'INITIALIZE THE OBJECT.
End If

ActiveSheet.Shapes.Range(Array("Group 329", "Group 302", "Group 320", _
  "Group 293", "Group 284", "TextBox 241", "TextBox 240", "TextBox 242", _
  "TextBox 243", "Group 275", "TextBox 244", "TextBox 245", "Group 257", _
  "Group 266", "TextBox 246", "TextBox 239", "Group 75", "TextBox 238")).Copy

With wdApp
  .Visible = True
  Set wdDoc = .Documents.Add       'Add new Page
  With wdDoc
    'set Margins
    With .PageSetup
      .TopMargin = wdApp.CentimetersToPoints(2.25)
      .BottomMargin = wdApp.CentimetersToPoints(0)
      .RightMargin = wdApp.CentimetersToPoints(0)
      .LeftMargin = wdApp.CentimetersToPoints(1.4)
    End With
    .Range.Paste     'Paste Report
  End With
End With
'Clean up the Object when Finished
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

When calling methods such as CentimetersToPoints, which exist in both Word and Excel, you should be explicit about which one you're using. There is also no need to prevent the code from running just because other documents are open.

 

[DouglasWicker]

Try:

Cheers, that worked, had to tweak a little but its good. I had to take the charts out of the 'With' because it would only paste the last for some reason. Here's the result;

Sub CopyReport()Dim wdApp As Object, wdDoc As Object
Dim filename As String


    On Error Resume Next
    Set wdApp = GetObject("Word.Application")
    On Error GoTo 0


    Worksheets("Report").Activate
    
    
    If wdApp Is Nothing Then
        Set wdApp = CreateObject(Class:="Word.Application")
        
        With wdApp
            .Visible = True
            .Activate
            Set wdDoc = .Documents.Add
            With wdDoc
                With .PageSetup
                    .TopMargin = wdApp.CentimetersToPoints(1)
                    .BottomMargin = wdApp.CentimetersToPoints(1)
                    .RightMargin = wdApp.CentimetersToPoints(1)
                    .LeftMargin = wdApp.CentimetersToPoints(1.3)
                End With
            End With
        End With
        
        ActiveSheet.ChartObjects("Chart 3").Activate
        ActiveChart.ChartArea.Copy
        wdApp.Selection.Paste
        
        ActiveSheet.ChartObjects("Chart 2").Activate
        ActiveChart.ChartArea.Copy
        wdApp.Selection.Paste
        
        ActiveSheet.ChartObjects("Chart 1").Activate
        ActiveChart.ChartArea.Copy
        wdApp.Selection.Paste
        
        ActiveSheet.Shapes.Range(Array("Group 16")).Select
        Selection.Copy
    
        wdApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=1
        
        wdApp.Selection.Paste
        
        wdApp.ActiveDocument.Shapes.Range(Array("Group 16")).ConvertToInlineShape
        
        wdApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=2
        
        wdApp.Selection.TypeParagraph
        
        wdApp.Selection.TypeParagraph
        
        wdApp.Selection.TypeParagraph


    Else
        MsgBox "No word documents can be open to generate a report."
    End If

    Set wdApp = Nothing
End Sub

 

[Macropod]

Your 'tweak a little' basically ignores the substance of the code I provided.

I'd have thought from the code I posted you'd have realised you don't need to Activate or Select anything in Excel or in Word. Unnecessarily activating and selecting things is really inefficient and tends to create a lot of screen flicker. And, as I also thought I'd made clear, there is no need to abort the process if Word is already running.

 

[DouglasWicker]

Your 'tweak a little' basically ignores the substance of the code I provided.

I'd have thought from the code I posted you'd have realised you don't need to Activate or Select anything in Excel or in Word. Unnecessarily activating and selecting things is really inefficient and tends to create a lot of screen flicker. And, as I also thought I'd made clear, there is no need to abort the process if Word is already running.

Sorry, I don't know VBA well but what I have written, I understand and works and that's all I need.

Thanks for your help anyway.