struggling to get this to work, the macro works on button push but, when i try to add above to run on open it bugs.
code below, just trying to add something to start the macro on open. I'm probably putting the codes in the wrong place. module/workbook, this would be
I've tried Private Sub Workbook_Open(), directly above the code
Sub PasteRangeinMail()
Dim FilePath As String
Dim Outlook As Object
Dim OutlookMail As Object
Dim HTMLBody As String
Dim rng As Range
On Error Resume Next
Set rng = Selection
If rng Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set Outlook = CreateObject("outlook.application")
Set OutlookMail = Outlook.CreateItem(olMailItem)
Call createImage(ActiveSheet.Name, rng.Address, "RangeImage")
FilePath = Environ$("temp") & "\"
HTMLBody = "<span LANG=EN>" _
& "<p class=style1><span LANG=EN><font FACE=Times New Roman SIZE=4>" _
& "" _
& "<br>" _
& "<br> " _
& "<br>" _
& "<img src='cid:RangeImage.jpg'>" _
& "<br>" _
& "<br></font></span>"
With OutlookMail
.Subject = ""
.HTMLBody = HTMLBody
.Attachments.Add FilePath & "RangeImage.jpg", olByValue
.To = "xxxxxxxx.com"
.CC = " "
.Subject = "Lead Time"
.send
End With
End Sub
Sub createImage(SheetName As String, rngAddrss As String, nameFile As String)
Dim rngJpg As Range
Dim Shape As Shape
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set rngJpg = ThisWorkbook.Worksheets(SheetName).Range(rngAddrss)
rngJpg.CopyPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(rngJpg.Left, rngJpg.Top, rngJpg.Width, rngJpg.Height)
.Activate
For Each Shape In ActiveSheet.Shapes
Shape.Line.Visible = msoFalse
Next
.Chart.Paste
.Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set rngJpg = Nothing
End Sub
code below, just trying to add something to start the macro on open. I'm probably putting the codes in the wrong place. module/workbook, this would be
I've tried Private Sub Workbook_Open(), directly above the code
Sub PasteRangeinMail()
Dim FilePath As String
Dim Outlook As Object
Dim OutlookMail As Object
Dim HTMLBody As String
Dim rng As Range
On Error Resume Next
Set rng = Selection
If rng Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set Outlook = CreateObject("outlook.application")
Set OutlookMail = Outlook.CreateItem(olMailItem)
Call createImage(ActiveSheet.Name, rng.Address, "RangeImage")
FilePath = Environ$("temp") & "\"
HTMLBody = "<span LANG=EN>" _
& "<p class=style1><span LANG=EN><font FACE=Times New Roman SIZE=4>" _
& "" _
& "<br>" _
& "<br> " _
& "<br>" _
& "<img src='cid:RangeImage.jpg'>" _
& "<br>" _
& "<br></font></span>"
With OutlookMail
.Subject = ""
.HTMLBody = HTMLBody
.Attachments.Add FilePath & "RangeImage.jpg", olByValue
.To = "xxxxxxxx.com"
.CC = " "
.Subject = "Lead Time"
.send
End With
End Sub
Sub createImage(SheetName As String, rngAddrss As String, nameFile As String)
Dim rngJpg As Range
Dim Shape As Shape
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set rngJpg = ThisWorkbook.Worksheets(SheetName).Range(rngAddrss)
rngJpg.CopyPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(rngJpg.Left, rngJpg.Top, rngJpg.Width, rngJpg.Height)
.Activate
For Each Shape In ActiveSheet.Shapes
Shape.Line.Visible = msoFalse
Next
.Chart.Paste
.Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set rngJpg = Nothing
End Sub