2

I have an excel document containing marks from student papers.

There is a summary tab which collates the marks into a more useable format for the students.

I have cobbled together some VBA code which opens a word doc and then steps through each students record, copying the output page and dropping it across into the word document.

The code runs and does what it is supposed to apart from failing part way through, at a different point each time.

I've tried paste and pastespecial, both fail in same way, this is where debugger indicates issue.

Error codes are usually 4605, though I have had 4198 and runtime error -2147023170

Hopefully someone can help a teacher out!

Code below

Sub Trilogy_output()

    Dim x As Integer
    Dim wdApp As Word.Application
    
        ' openword fdoc
    Set wdApp = New Word.Application
    With wdApp
        .Visible = True
        .Activate
        .Documents.Add
    End With
    
       ' Select main data sheet
    Sheets("Physics").Select
    Range("A12").Select

      ' Set numrows = number of rows of data.
    NumRows = Range("A12", Range("A12").End(xlDown)).Rows.Count
      
      ' Select starting cell.
    Range("A12").Select
      
      ' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows
    
         ' paste name to output sheet
        Selection.Copy
        Sheets("Trilogy Output").Select
        Range("B2").Select
        ActiveSheet.Paste
        
        ' copy sheet to word
        Range("A1:G40").Select
        Selection.Copy
    With wdApp.Selection
        ' .Paste
        .PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
        .InsertBreak Type:=7
    End With
    Application.CutCopyMode = False
    ' Selects cell down 1 row from active cell.
    Sheets("Physics").Select
    ActiveCell.Offset(1, 0).Select
    Next
    
Application.ScreenUpdating = True

End Sub
mwnm
  • 23
  • 2
  • 2
    The reliability of this code could be drastically improved by reducing the usage of `.Select` and `Selection`. This is two-fold because the `Selection` object in Excel is very different from the `Selection` object in Word. [Here](https://stackoverflow.com/a/10717999/14608750)'s a useful answer on how to do that. – Toddleson Nov 17 '21 at 16:36
  • It is because you are using the clipboard which is controlled by the OS. You need to allow the OS to catch up with your code. You may get away with adding `DoEvents` after each copy. – Timothy Rylatt Nov 17 '21 at 17:01
  • Thanks both. This is the first vba code I’ve tried to produce, rather than just recording a macro, and even then this is mostly by copy/pasting bits that seemed to do what I wanted - so any input like this is really helpful. – mwnm Nov 17 '21 at 17:35

1 Answers1

1

To improve the reliability of the code, it's best to eliminate the use of Select and Selection whenever possible. Relying on Selection to be always pointing at the correct object or range is messy and hard to keep track of. It is also vulnerable to errors because something could become unintentionally selected by the user or by a method during execution.

To give an example of how to remove .Select and .Selection see the following edited version of your program.

Sub Trilogy_output()
    Application.ScreenUpdating = False

        ' openword fdoc
    Dim wdApp As New Word.Application
    With wdApp
        .Visible = True
        .Activate
        .Documents.Add
    End With
    
       ' main data sheet
    Dim Phys As Worksheet
    Set Phys = ThisWorkbook.Sheets("Physics")

    Dim Tri As Worksheet
    Set Tri = ThisWorkbook.Sheets("Trilogy Output")

    Dim CurrentCell As Range
    Set CurrentCell = Phys.Range("A12") 'Starting Cell

      ' Set numrows = number of rows of data.
    Dim NumRows As Long
    NumRows = CurrentCell.End(xlDown).Row - CurrentCell.Row + 1
      
      ' Establish loop through column "A" of Phys from row 12 to end.
    Dim x As Long
    For x = 1 To NumRows
         ' paste name to output sheet
        CurrentCell.Copy Destination:=Tri.Range("B2")
        
        Tri.Range("A1:G40").Copy
        DoEvents
        With wdApp.Selection
            ' copy sheet to document
            .PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
            .InsertBreak Type:=7
        End With
        Application.CutCopyMode = False
        
        'Move the current cell down by 1
        Set CurrentCell = CurrentCell.Cells(2)
    Next
    
    Application.ScreenUpdating = True

End Sub

Description of the changes:

  • Two worksheet variables, Phys and Tri, were created to save the references to the "Physics" and "Trilogy Output" sheets. This can allow us to get Ranges from those sheets without Selecting them.
  • A Range Object, CurrentCell, was created to track the Range in the "Physics" sheet that is being copied over. Declaring the range allows us to minimize the number of times that the constant "A12" is written. This simplifies things if that needs to be edited later.
  • NumRows and x were changed from Integer to Long because Excel Row numbers have the potential to cause overflow error with Integers.
  • Using the Destination argument of Range.Copy allows us to skip using the Clipboard when copying between sheets in the same Excel application. This is much faster than using the clipboard and more reliable since we removed the reliance on Selection.
  • DoEvents was added after the .Copy. @TimothyRylatt mentioned this could help resolve issues where the clipboard needs time to finish processing.
  • .Cells(2) is the same as .Offset(1,0) for moving the cell down by 1. But I have had issues with Offset and prefer to avoid using it when I can.
Toddleson
  • 4,321
  • 1
  • 6
  • 26