Results 1 to 3 of 3

Problem with R1C1 in Formulae when Running Code

Threaded View

  1. #1
    Registered User
    Join Date
    06-15-2023
    Location
    POland
    MS-Off Ver
    365
    Posts
    1

    Problem with R1C1 in Formulae when Running Code

    Hello,

    In my place i'm using vba script to paste ready table to email.
    It's working okay but problem appear when users are using R1C1 style in Excel formulas.
    That code is making problem:
    Dim rng As Range
    Set rng = Range("A:C")


    i was trying to replace it with Cells() but without success.
    when i do it i have new sheet without email pasted.

    Could you please help me to solve that issue? How to change the Range to working for both ways of formulas.

    Thats all the code:

    
    
    Sub Paste_Range_Outlook()
    Dim rng As Range
    Dim Outlook As Object
    Dim OutlookMail As Object
    Set rng = Nothing
    On Error Resume Next
    
    
    Set rng = Range("A:C")
    
    
    On Error GoTo 0
    If rng Is Nothing Then
    MsgBox "Not a range or protected sheet" & _
    vbNewLine & "please correct and try again.", vbOKOnly
    Exit Sub
    End If
    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With
    Set Outlook = CreateObject("Outlook.Application")
    Set OutlookMail = Outlook.CreateItem(0)
    On Error Resume Next
    With OutlookMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = " " & Date
    .HTMLBody = RangetoHTML(rng)
    .Display 'or use .Send
    End With
    On Error GoTo 0
    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With
    Set OutlookMail = Nothing
    Set Outlook = Nothing
    End Sub
    Function RangetoHTML(rng As Range)
    Dim obj As Object
    Dim txtstr As Object
    Dim File As String
    Dim WB As Workbook
    File = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set WB = Workbooks.Add(1)
    With WB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
    End With
    With WB.PublishObjects.Add( _
    SourceType:=xlSourceRange, _
    Filename:=File, _
    Sheet:=WB.Sheets(1).Name, _
    Source:=WB.Sheets(1).UsedRange.Address, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
    End With
    Set obj = CreateObject("Scripting.FileSystemObject")
    Set txtstr = obj.GetFile(File).OpenAsTextStream(1, -2)
    RangetoHTML = txtstr.readall
    txtstr.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
    "align=left x:publishsource=")
    WB.Close savechanges:=False
    Kill File
    Set txtstr = Nothing
    Set obj = Nothing
    Set WB = Nothing
    End Function
    Last edited by Maciej Bocian; 06-15-2023 at 03:31 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1