Error 1004 - Can't Copy as Picture, but only on certain computer

[MrPoindexter]

This is breaking my head, and I don't get it. I have a project that is using a very large excel spreadsheet to update content controls in Word. Part of the project selects large ranges in excel and copies them as pictures. I have ran the VBA on 9 different computers, and it works perfectly. Two colleagues keep getting the same 1004 error. "CopyPicture method of Range class failed". They are both running with multiple displays. I've tested it with and without displays, works fine. One colleague is using an HP Pavilion, Windows 11 Home version. BIOS F.04 November 2023. All windows updates are in. Fails. I bought the identical computer, except it has BIOS F.03 August of 2023. Works fine. I've tried just about everything you can think of, and I am at my wits end. Need help. Here is a sample of the code:

Sub M12BDF()
Dim cc As Object
Dim ws As Worksheet
Dim excelRanges() As Range
Dim contentControlTitles() As String
Dim i As Integer
Dim foundImage As Boolean
Dim founText As Boolean
Dim wb As Workbook

' Check if the target workbook has been set
If targetWorkbook Is Nothing Then
MsgBox "No target workbook selected. Please select a workbook first.", vbCritical
Exit Sub
End If

' Check if a Word document has been selected
If SelectedWordDoc Is Nothing Then
MsgBox "No Word document selected. Please reopen the Excel workbook and select a document.", vbCritical
Exit Sub
End If

' Excel part: Define the ranges to be copied as pictures
Set wb = targetWorkbook
Set ws = targetWorkbook.Sheets("Buildings")
ReDim excelRanges(2)
Set excelRanges(0) = ws.Range("B2:Q19")
Set excelRanges(1) = ws.Range("W2:AK19")
Set excelRanges(2) = ws.Range("C23:J37")

' Assigning titles to the array
ReDim contentControlTitles(2)

' Assigning titles to the array, one per line
contentControlTitles(0) = "cvas_dt_building_inventory"
contentControlTitles(1) = "cvas_dt_building_RCN"
contentControlTitles(2) = "cvas_dt_Site_ImpRCN1"

' Loop through the arrays to copy each Excel range and paste it into the corresponding Content Control in Word
wb.Activate
ws.Activate


For i = LBound(excelRanges) To UBound(excelRanges)
' Scroll the range into view
ws.Activate
Application.GoTo Reference:=excelRanges(i), Scroll:=True


On Error Resume Next ' Start error handling
excelRanges(i).CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Application.CutCopyMode = False ' Exit cut/copy mode to help clear clipboard
' Check if the CopyPicture method succeeded
If Err.Number = 0 Then
For Each cc In SelectedWordDoc.ContentControls
If cc.Title = contentControlTitles(i) Then
cc.Range.Delete
' Attempt to paste and check for errors
On Error Resume Next
cc.Range.Paste
If Err.Number = 0 Then
foundImage = True
Else
MsgBox "Error pasting picture: " & Err.Description
' Handle paste error, e.g., try again or log error
End If
On Error GoTo 0 ' Stop error handling for paste
End If
Next cc
Else
MsgBox "Error copying picture: " & Err.Description
' Handle copy error, e.g., try again or log error
End If
On Error GoTo 0 ' Stop error handling for copy
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

' Message indicating completion and whether updates were made
If Not SuppressMessages Then
If foundImage Or foundText Then
MsgBox "DocuFaze Successful", vbInformation
Else
MsgBox "No specified Content Controls were found in the active Word document.", vbExclamation
End If
End If
' Cleanup
Set ws = Nothing
Set wb = Nothing
End Sub


Note - I am using error handlers throughout.

 

[rlv01]

Thank you. I did go through this thread prior to posting my question. That thread seems to go in a million different directions, and I'm not sure where to start.

Not a million, only a few. As always, start with the simple recommendations and work up from there. So the first & second things I would try would be to replace this

  excelRanges(I).CopyPicture Appearance:=xlPrinter, Format:=xlPicture

with this:

        excelRanges(I).Copy 'just for nothing
        excelRanges(I).CopyPicture Appearance:=xlPrinter, Format:=xlPicture

and/or this:

        Application.CutCopyMode = False
        excelRanges(I).CopyPicture Appearance:=xlPrinter, Format:=xlPicture

because they are both easy changes, and because at least some people reported success using them.