agentkramr
Board Regular
- Joined
- Dec 27, 2021
- Messages
- 98
- Platform
- Windows
i am formulating a VBA that will attach a workbook to an email with all of the sheets, but it will take a screen shot a section of the newest sheet and attach that to the body of the email. i will also need to add some lead text to that so body text.
i am getting a debug error that says it doesnt support this propert or method
it takes me to line
which i am assuming Application.ActiveSheet is the wrong call to be making.
i cant call it by name as the newest sheet name will change every single day.
Any advice on a different way to summon the newest sheet added to the workbook ?
the newest sheet should always be saved as the "top sheet" or "selected" sheet every time as i am using another VBA to make that happen
VBA Code:
Sub CBTN_Email()
Dim oApp As Object, oMail As Object, FileStr As String
Dim NewWb As Workbook, cnt As Integer
Dim FileName As String, MailSub As String, MailTxt As String
Dim tmpImageName As String
'************************************************* ********
'Set email details; Comment out if not required
Const MailTo = "test@test.com"
'Const MailCC = "test@test.com"
Const MailBCC = "test@test.com"
MailSub = "Test"
MailTxt = ""
'Workbooks("thisworkbook").RefreshAll
'Turns off screen updating
Application.ScreenUpdating = False
'Sheets("(Test").Unprotect "Test"
'define a temp path for your image
tmpImageName = Environ$("temp") & "" & "TempChart.jpg"
'create image file
Call CreateJpg(Application.ActiveSheet, Sheets(Application.ActiveSheet).Range("A1:AZ48"))
'copy range to new wb/remove formulas
Set NewWb = Workbooks.Add
'copy all sheets
For cnt = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(cnt).Copy NewWb.Sheets(cnt)
Next cnt
NewWb.Sheets(Application.ActiveSheet).Range("A1:AZ48").Copy
NewWb.Worksheets(Application.ActiveSheet).Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'NewWb.Worksheets("Test").Shapes("Rectangle: Rounded Corners 1").Delete
'NewWb.Worksheets("Test").Shapes("Rectangle: Rounded Corners 2").Delete
NewWb.Worksheets(Application.ActiveSheet).Activate
NewWb.Worksheets(Application.ActiveSheet).Range("A1").Select
Application.DisplayAlerts = False
NewWb.Worksheets("Sheet1").Delete
NewWb.SaveAs FileName:=Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 5) & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
FileStr = NewWb.FullName
NewWb.Close
'Sheets("Test").Protect "Test"
'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = MailTo
.Cc = MailCC
.Bcc = MailBCC
.Subject = MailSub
.HTMLBody = "<body><img src=" & "'" & tmpImageName & "'/></body>"
.Attachments.Add FileStr
.Display
.Send
End With
'Deletes the temporary file
'WB.ChangeFileAccess Mode:=xlReadOnly
Kill (Environ$("temp") & "" & "TempChart.jpg")
Kill FileStr
'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
'Save Workbook
'ThisWorkbook.Save
End Sub
Public Sub CreateJpg(SheetName As String, xRgAddrss As Range)
'creates temp JPG file of range (xRgAddrss) by creating temp chart
'uses current wb sheet (sheetname) to locate temp chart
Dim xRgPic As Range
Worksheets(SheetName).Activate
Set xRgPic = xRgAddrss
xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, _
xRgPic.Width, xRgPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "" & "TempChart.jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
End Subi am getting a debug error that says it doesnt support this propert or method
it takes me to line
VBA Code:
Call CreateJpg(Application.ActiveSheet, Sheets(Application.ActiveSheet).Range("A1:AZ48"))which i am assuming Application.ActiveSheet is the wrong call to be making.
i cant call it by name as the newest sheet name will change every single day.
Any advice on a different way to summon the newest sheet added to the workbook ?
the newest sheet should always be saved as the "top sheet" or "selected" sheet every time as i am using another VBA to make that happen
