This forum is closed to new posts and responses. Individual names altered for privacy purposes. The information contained in this website is provided for informational purposes only and should not be construed as a forum for customer support requests. Any customer support requests should be directed to the official HCL customer support channels below:

HCL Software Customer Support Portal for U.S. Federal Government clients
HCL Software Customer Support Portal


Sep 26, 2018, 12:21 PM
1 Posts

How to paste the whole range from Excel to Lotus as bitmap?

  • Category: Notes Client
  • Platform: Windows
  • Release: 9.0
  • Role: Developer
  • Tags: excel,vba
  • Replies: 0

I wrote a macro in Excel that works out quite well (btw I work on Lotus Notes 8.5, not 9). I'm able to copy and paste given range (to be precise a pivot table) as bitmap but the problem is that not the whole are is copied, only a part of a table.

Here is the code, what's wrong with pasting? Why can't I copy the whole table, just a part of it? Variables rows and columns are ok and return proper values.

 

Public Sub Lotus_Mail()

Dim NSession As Object
Dim NUIWorkSpace As Object
Dim NDatabase As Object
Dim NDoc As Object
Dim NUIdoc As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String
Dim pivots As Range
Dim Month As String
Dim text1 As Range
Dim text2 As Range
Dim i As Integer


Dim arrHUBs(1 To 8) As String

arrHUBs(1) = "a"
arrHUBs(2) = "b"
arrHUBs(3) = "c"
arrHUBs(4) = "d"
arrHUBs(5) = "e"
arrHUBs(6) = "f"
arrHUBs(7) = "g"
arrHUBs(8) = "h"

Week = DatePart("ww", Date, vbMonday, vbFirstFourDays)
Month = MonthName(DatePart("m", Date), False)

On Error Resume Next

For x = 1 To 8

SendTo = Application.WorksheetFunction.VLookup(arrHUBs(x),      Sheets("Mail").Range("A2:C9"), 2, 0)
CopyTo = Application.WorksheetFunction.VLookup(arrHUBs(x), Sheets("Mail").Range("A2:C9"), 3, 0)
Subject = "Summary " & arrHUBs(x) & " - " & Month & ": week " & Week

'area to select (pivot table)
rows = Sheets("sheet").Cells(Rows.Count, 21).End(xlUp).Row
columns = Sheets("sheet").Cells(6, Columns.Count).End(xlToLeft).Column
Set pivots = Sheets("sheet").Range(Cells(4, 19), Cells(rows, columns))
'Set pivots = Sheets("sheet").PivotTables("Pivot1")  ???this line doesn't work, any other way to select pivot and paste to Lotus?

Set text1 = Sheets("Mail").Range("A12")
Set text2 = Sheets("Mail").Range("A13")

'Lotus step by step
Set NSession = CreateObject("Notes.NotesSession") 
Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set NDatabase = NSession.GetDatabase("", "")
If Not NDatabase.IsOpen Then NDatabase.OPENMAIL

'creating mail
Set NDoc = NDatabase.CreateDocument

    With NDoc
    .SendTo = SendTo
    .CopyTo = CopyTo
    .Subject = Subject

    'Email body text, including a placeholder which will be replaced by Excel table

    .body = text1 & vbLf & vbLf & _
        "{IMAGE_PLACEHOLDER}" & vbLf

    .Save True, False
End With

'Edit the new document using Notes UI to copy and paste pivot table into it

Set NUIdoc = NUIWorkSpace.EDITDocument(True, NDoc)

With NUIdoc
    Sheets("sheet").Select

    'Find the placeholder in the Body item 

    .GotoField ("Body")        
    .FINDSTRING "{IMAGE_PLACEHOLDER}"
    '.DESELECTALL 'Uncomment to leave the placeholder in place (cells are inserted immediately before it)

    'Copy pivot table (being a range) as a bitmap to the clipboard and paste into the email

    pivots.CopyPicture xlBitmap
    .Paste 'maybe any paste special option exists?
    Application.CutCopyMode = False

    '.Send
    '.Close
End With

Set NSession = Nothing

Next x
End Sub

This forum is closed to new posts and responses. Individual names altered for privacy purposes. The information contained in this website is provided for informational purposes only and should not be construed as a forum for customer support requests. Any customer support requests should be directed to the official HCL customer support channels below:

HCL Software Customer Support Portal for U.S. Federal Government clients
HCL Software Customer Support Portal