標題: [發問] Notes的表格欄位寬度不同於Excel的欄位寬度的問題 [打印本頁]

---

作者: 劉大胃    時間: 2021-1-29 14:06     標題: Notes的表格欄位寬度不同於Excel的欄位寬度的問題

Hello, 各位大大

如下程式段裡的紅字, 其Excel資料轉貼的方式至Notes裡,
但常會有格式跑掉(Notes的表格欄位寬度不同於Excel的欄位寬度)的問題.
故不知有沒有指令可以將其表格轉為"圖片模式" 至Notes上.
或是有其他的方式, 讓Notes上的表格寬度與Excel相同?!
Thanks ~

[[程式段]]
       Dim es As Object
       Dim at As Object
       Dim Work As Object
       Dim oc As Object
       Dim doc As Object
       Dim strMsg As String
       Dim UserName As String 'The current users notes name
       Dim MailDbName As String 'THe current users notes mail database name
       Dim dbleCPRow As Double
                     
       Set es = CreateObject("Notes.NotesSession")
       Set Work = CreateObject("Notes.NotesUIWorkspace")
        
       UserName = es.UserName
       MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
               
       Set at = es.GetDataBase(vbNullString, MailDbName)
       If Not at.IsOpen Then
          at.OPENMAIL
       Else
          MsgBox "Mail Open Fail..!"
       End If
        
       Set oc = at.CreateDocument
       With oc
            .Form = "Memo"
            .sendto = "david"  
            .Subject = "Mail Sending Try..."
       End With
                                
       dblCPRow = Application.WorksheetFunction.CountIf(Range("$H$3:$H$666"), "<>") + 2   ' +2 is report title ignored
      
       Set doc = Work.EDITDocument(True, oc)
       With doc
             .InsertText ("<< Mail autot Sending >> ")
            Range("A2:K" & dblCPRow).Copy
            .Paste                                 ===>> 我如何使用如PasteSpecial指今, 將其值轉為 "圖片" 貼至Notesl裡.
            Application.CutCopyMode = False
            .send
            .Close
       End With
       Set es = Nothing
       Set at = Nothing
       Set Work = Nothing
       Set oc = Nothing
       Set doc = Nothing

       MsgBox "Mail had been sent..!"

---

作者: 劉大胃    時間: 2021-2-3 14:35

Hello, All

如下所示, 我找到了一個土法練鋼的方式!!
即在Excel內將表格轉為圖片, 然後再將此圖片轉貼至IBM Notes裡,
最後再將產生的圖片刪除, 即可.
如此一來, 除非Target端不接受圖片, 否則就不用去考慮其是什麼格式了!!
與大夥分享.....Thanks ~~


[[程式段]]
        Dim es As Object
        Dim at As Object
        Dim Work As Object
        Dim oc As Object
        Dim doc As Object
        Dim rgPic As Range
        Dim strMsg As String
        Dim UserName As String 'The current users notes name
        Dim MailDbName As String 'THe current users notes mail database name
        Dim dbleCPRow As Double
                       
        Set es = CreateObject("Notes.NotesSession")
        Set Work = CreateObject("Notes.NotesUIWorkspace")
         
        UserName = es.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
                 
        Set at = es.GetDataBase(vbNullString, MailDbName)
        If Not at.IsOpen Then
           at.OPENMAIL
        Else
           MsgBox "Mail Open Fail..!"
        End If
         
        Set oc = at.CreateDocument
        With oc
             .Form = "Memo"
             .sendto = "david"  
             .Subject = "Mail Sending Try..."
        End With
                                 
        dblCPRow = Application.WorksheetFunction.CountIf(Range("$H$3H$666"), "<>") + 2   ' +2 is report title ignored
        
        Set doc = Work.EDITDocument(True, oc)
        With doc
              .InsertText ("<< Mail autot Sending >> " & vbNewLine )
             Set rgPic = Range("A2:K" & dblCPRow)
            rgPic.CopyPicture Appearance:=xlScreen, Format:=xlPrinter     ' Trans Excel Table to Picture mode.
            With ActiveSheet.ChartObjects.Add(Left:=rgPic.Left, Top:=rgPic.Top, Width:=rgPic.Width, Height:=rgPic.Height)           ' Set Picture name to tmpChart
                   .Name = "tmpChart"
                   .Activate
             End With
            .Paste
            Application.CutCopyMode = False
           ActiveSheet.ChartObjects("tmpChart").Delete         ' Delete this template chart.
             .send
             .Close
        End With
        Set es = Nothing
        Set at = Nothing
        Set Work = Nothing
        Set oc = Nothing
        Set doc = Nothing
        set rgPic =Nothing

        MsgBox "Mail had been sent..!"

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)