Copy Selection as Picture Issue

[Marhier]

Morning everyone.
I've arranged a bit of code that filters my workbook, selects a named range, copies that range as a picture, opens up a new email on Lotus Notes (unfortunately), pastes that pitcure in the email's body, along with various other text as well as grabbing recipiants and a subject.

This has been working like a dream for about 6 months, until yesterday...
Users started getting emails where the picture that's copied is missing the colour format of each cell.
Testing manually, if I paste directly to Word or Excel, it works fine... When I try and paste into Lotus Notes or Paint even, I get this issue!

See following picture that demonstrates what I mean - the left is Lotus Notes and the right is Word:

<a href="https://ibb.co/zVcdfmm"><img src="https://i.ibb.co/B2Dksff/Untitled.png" alt="Untitled" border="0"></a>

Would anyone have any idea why this would start happening; it's almost like anything other than text, with a colour has become transparent in certain applications.


My code is as follows:

Sub NotifyHires()
Application.ScreenUpdating = False
On Error GoTo Errormessage
Dim wsSheet As Worksheet, rRng As Range
Set wsSheet = ActiveSheet
Set rRng = wsSheet.Range("PlantReqTable")
Dim Notes As Object, db As Object, WorkSpace As Object
Dim UIdoc As Object, UserName As String, MailDbName As String
Dim AttachMe As Object, EmbedObj As Object

'Set email addresses
EmailAddress = Range("BuyerEmail").Value
ccEmailAddress = Range("ccBuyer1").Value '& "; " & Range("ccBuyer2").Value

'Set email subject
HireSubject = Range("HireSubject").Value

'Unprotect sheet
Call PR_UnProtect

'Filter column J by "O" and copy the selection as a picture
With rRng
    .AutoFilter Field:=10, Criteria1:="O"
    If .SpecialCells(xlCellTypeVisible).Address = .Rows(1).Address Then
    MsgBox "There are no lines set as 'To Order' - Status 'O'."
    wsSheet.AutoFilter.ShowAllData
    Call PR_Protect
    Application.ScreenUpdating = True
Exit Sub
Else
End If
End With
wsSheet.Range("FilterList1").CopyPicture

'Open Lotus Notes & Get Database
Set Notes = CreateObject("Notes.NotesSession")
UserName = Notes.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, _
    (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set db = Notes.GETDATABASE(vbNullString, MailDbName)

'Create & Open New Document
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.COMPOSEDOCUMENT(, , "Memo")
Set UIdoc = WorkSpace.CURRENTDOCUMENT

'Add Picture & text
Call UIdoc.FieldSetText("EnterSendTo", EmailAddress)
Call UIdoc.FieldSetText("EnterCopyTo", ccEmailAddress)
Call UIdoc.FieldSetText("Subject", HireSubject)
Call UIdoc.gotofield("Body")
Call UIdoc.INSERTTEXT(WorksheetFunction.Substitute( _
    "Hello@@The following items have been added to the the plant register:@@", _
    "@", vbCrLf))
Call UIdoc.Paste
Call UIdoc.INSERTTEXT(Application.Substitute( _
    "@@Thank you@@", "@", vbCrLf))

'Unfilter active sheet
wsSheet.AutoFilter.ShowAllData

'Protect Sheet
Call PR_Protect
Application.ScreenUpdating = True
Exit Sub

Error handler
Errormessage:
MsgBox "Is Lotus Notes running, and have you put email addresses in the required fields?"
wsSheet.AutoFilter.ShowAllData
Call PR_Protect
Application.ScreenUpdating = True
End Sub

Any help would be greatly appreciated.
Thank you.
Regards
Marhier.

 

[Marhier]

Ok, I've sorted it.
When copying as a picture, it gives you the option to copy as 'Picture', or 'Bitmap'.

I've amended the code from:

wsSheet.Range("FilterList1").CopyPicture

to:

wsSheet.Range("FilterList1").CopyPicture Appearance:=xlScreen, Format:=xlBitmap

I'm still intereted to know why after 6 months, this suddenly stopped working.
What's changed that .CopyPicture makes all cell colours and borders transparent?

If anyone could shed some light, I'd appreciate it.

Regards
Marhier.