Macro to Screenshot Excel and Paste Image to MS Word

Originally Posted by ramlineses

Is there a macro code that will screenshot a specific group of cells in a worksheet and paste it in MS Word as an image when a button is clicked?

Specific cells - columns A to AJ, rows 1 to 70

That's a huge range to paste as a single picture. While it can be done, the picture would probably be illegible. That said, you could use code like:

Sub Demo()
Application.ScreenUpdating = True
Dim wdApp As Object, wdDoc As Object, StrDocNm As String
Dim bStrt As Boolean, bFound As Boolean
'Check whether the document exists
StrDocNm = "C:\Users\" & Environ("Username") & "\Documents\Document Name.doc"
If Dir(StrDocNm) = "" Then
  MsgBox "Cannot find the designated document: " & StrDocNm, vbExclamation
  Exit Sub
End If
' Test whether Word is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Word, so we can close it later.
Set wdApp = GetObject(, "Word.Application")
'Start Word if it isn't running
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
  If wdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Word, so we can terminate it later.
  bStrt = True
End If
On Error GoTo 0
'Check if the document is open.
bFound = False
With wdApp
  'Hide our Word session
  If bStrt = True Then .Visible = False
  For Each wdDoc In .Documents
    If wdDoc.FullName = StrDocNm Then ' We already have it open
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrDocNm) = True Then
      ' Report and exit if true
      MsgBox "The Word document is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set wdDoc = .Documents.Open(Filename:=StrDocNm)
    If wdDoc Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrDocNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  ActiveSheet.Range("A1:AJ70").Copy
  With wdDoc
    'Only now can we can process the document!!!
    .Bookmarks("myBookmark").Range.PasteSpecial , False, 0, False, 9
    .Save
    'Close the document if we opened it
    If bFound = False Then .Close
  End With
  If bStrt = True Then .Quit
End With
End Sub

Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function

The above code copies A1:AJ70 from the active sheet and pastes it into a Word document named 'Document Name.doc' in your Documents folder, at a bookmark named 'myBookmark'.