В рабочем файле есть два листа. На одном из них с названием "CMR-LT" есть формулы. Нужно по нажатию кнопки (она на листе с именем CALC) преобразовать все формулы на листе "CMR-LT" в значения, затем вызвать Outlook и прикрепить этот преобразованный лист к окну нового сообщения. При этом в subject-е письма должно автоматически прописываться название инвойса. (в ячейке B1 примера выделенно красным что именно должно прописываться) Также из диспечера имен преобразованного листа должны удаляться все лишние именнованные диапазоны. Остаться должен лишь "Print Area".
Можно ли сделать такое макросом? Если да, то буду признателен за помощь. Структура рабочего файла в примере.
UPD: В сети разыскал макрос который преобразует формулы в значения и сохраняет лист по указанному пути. При этом он нарушает исходное форматирование.
Sub memo1()
Worksheets("CMR-LT").UsedRange.Copy
Worksheets("CMR-LT").UsedRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub
Sub memo2()
Dim IName As Name
For Each IName In ActiveWorkbook.Names
On Error Resume Next
If Not IName.Name Like "*Print_Area*" Then
IName.Delete
End If
Next IName
End Sub
Sub memo3()
Dim olApp As Object
Dim olEmail As Object
Set olApp = CreateObject("Outlook.Application")
Set olEmail = olApp.CreateItem(olMailItem)
ThisWorkbook.Sheets("CMR-LT").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\файлик.xlsx"
With olEmail
.BodyFormat = 2
.Subject = ThisWorkbook.Sheets("CALC").Range("B1").Value
.Attachments.Add (ThisWorkbook.Path & "\файлик.xlsx")
.Display
End With
ActiveWorkbook.Close SaveChanges:=True
Kill ThisWorkbook.Path & "\файлик.xlsx"
End Sub
Sub memo()
memo1
memo2
memo3
End Sub
pantel1987, Вы замечательно все поняли и сделали, спасибо! Правда есть одно очень существенное но: именованные диапазоны должны удаляться у прикрепленного листа (у созданного файлика) а не у исходного. Исходный лист должен оставаться без изменений.
Sub memo()
Dim olApp As Object
Dim olEmail As Object
Dim IName As Name
Set olApp = CreateObject("Outlook.Application")
Set olEmail = olApp.CreateItem(olMailItem)
ThisWorkbook.Worksheets("CMR-LT").UsedRange.Copy
ThisWorkbook.Worksheets("CMR-LT").UsedRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
ThisWorkbook.Sheets("CMR-LT").Copy
For Each IName In ActiveWorkbook.Names
On Error Resume Next
If Not IName.Name Like "*Print_Area*" Then
IName.Delete
End If
Next IName
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\файлик.xlsx"
With olEmail
.BodyFormat = 2
.Subject = ThisWorkbook.Sheets("CALC").Range("B1").Value
.Attachments.Add (ThisWorkbook.Path & "\файлик.xlsx")
.Display
End With
ActiveWorkbook.Close SaveChanges:=True
Kill ThisWorkbook.Path & "\файлик.xlsx"
End Sub
Sub memo()
Dim olApp As Object
Dim olEmail As Object
Dim IName As Name
Set olApp = CreateObject("Outlook.Application")
Set olEmail = olApp.CreateItem(olMailItem)
ThisWorkbook.Sheets("CMR-LT").Copy
For Each IName In ActiveWorkbook.Names
On Error Resume Next
If Not IName.Name Like "*Print_Area*" Then
IName.Delete
End If
Next IName
ActiveWorkbook.Worksheets("CMR-LT").UsedRange.Copy
ActiveWorkbook.Worksheets("CMR-LT").UsedRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\файлик.xlsx"
With olEmail
.BodyFormat = 2
.Subject = ThisWorkbook.Sheets("CALC").Range("B1").Value
.Attachments.Add (ThisWorkbook.Path & "\файлик.xlsx")
.Display
End With
ActiveWorkbook.Close SaveChanges:=True
Kill ThisWorkbook.Path & "\файлик.xlsx"
End Sub