Problem with R1C1 in Formulae when Running Code

[Maciej Bocian]

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

[AliGW]

Administrative Note:

Welcome to the forum.

You need to read the forum rules regarding thread titles and code tags.

We would very much like to help you with your query, however the thread title does not really convey what your request is about. Tell us what you are trying to do, not how you think it should be done.

Please take a moment to amend your thread title. Make sure that the title properly explains your request. Your title should be explicit and not be generic (this includes function names used without an indication of what you are trying to achieve).

Please see Forum Rule #1 about proper thread titles and adjust accordingly. To edit the thread title, open the original post to edit and then click on Go Advanced (bottom right) to access the area where you can edit your title.

(Note: this change is not optional. As you are new here, I have done it for you this time.)

[Croweater]

Untested...but maybe something like this?

    If Application.ReferenceStyle = xlR1C1 Then
        Set rng = Range(Cells(1, 1), Cells(999, 3))
    Else
        Set rng = Range("A:C")
    End If