печать листов excel с почты

[vektorss]

Как выставить по умолчанию на вновь создаваемые листы excel в параметрах страницы , разместить не более чем на одном листе? С шаблонами не получается, макрос тоже...
Мне приходит письмо в outlook с вложенным файлом , при его распечатке постоянно приходится входить и менять параметры..

[EducatedFool]

Макрос можно написать
Один раз вручную настроить не получится, - эти опции сохраняются внутри файла (у каждого файла свои), и файл каждый раз новый

[Aleksandr H.]

EducatedFool, а в Personal прописать не сработает?

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 With sh.PageSetup
.FitToPagesWide = 1
        .FitToPagesTall = 1
end with
End Sub

для себя я кнопку на ленту вывел, которая листа подгоняет под вывод

[EducatedFool]

в Personal прописать не сработает

сработает, только кода надо больше (чтобы не каждый лист любого файла обрабатывал, а только нужные файлы)
+ нужен код перехвата событий приложения
+ этот код автоматически не всегда будет срабатывать (после некоторых действий в Excel, переменные очищаются)

PS: лично я бы сделал кнопку с макросом, как вы сделали

[vektorss]

Сейчас попробую вставить его. Пожалуйста посмотрите этот макрос:
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim olNameSpace As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder

Set olNameSpace = Application.GetNamespace("MAPI")
Set Folder = olNameSpace.GetDefaultFolder(olFold erInbox)
Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
PrintAttachments Item
End If
End Sub

'Печать вложений из письма
Private Sub PrintAttachments(olItem As Outlook.MailItem)
On Error Resume Next
Dim colAtts As Outlook.Attachments
Dim olAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String
Dim pa As PropertyAccessor
Dim is_attach As Boolean
Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
Dim str1() As String
Dim str2() As String

sDirectory = "C:\Test\"

Set colAtts = olItem.Attachments

If colAtts.Count Then
For Each olAtt In colAtts

is_attach = False
'Проверяем не является ли файл элементом оформления письма
Set pa = objAtt.PropertyAccessor
cid = pa.GetProperty(PR_ATTACH_CONTENT_ID )

If Len(cid) > 0 Then
If InStr(itm.HTMLBody, cid) Then
is_attach = False
Else
'Если не существует PR_ATTACHMENT_HIDDEN, то возникнет ошибка
'Просто игнорируем эту ошибку и интерпретируем как False
On Error Resume Next
If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN ) Then
is_attach = True
End If
On Error GoTo 0
End If
Else
is_attach = True
End If

'определение расширения файла
str1 = Split(olAtt.FileName, ".")
sFileType = "." & LCase(str1(UBound(str1)))

Select Case sFileType
Case ".xls", ".xlsx", ".doc", ".docx"
sFile = sDirectory & "FileForPrint_" & olAtt.Index & sFileType
olAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
Case ".pdf"
sFile = sDirectory & "FileForPrint_" & olAtt.Index & sFileType
olAtt.SaveAsFile sFile
'Прописать путь к AcroRd32.exe
Shell "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe /p /h " & sFile
Case ".jpg", ".png"
sFile = sDirectory & "FileForPrint_" & olAtt.Index & sFileType
olAtt.SaveAsFile sFile
'Прописать путь к mspaint.exe
Shell "C:\WINDOWS\system32\mspaint.ex e " & sFile & " /p"
Case ".zip", ".rar"
sFile = sDirectory & "FileForPrint_" & olAtt.Index & sFileType
sDir = sDirectory & "FileForPrint_" & olAtt.Index
If Dir(sDir, vbDirectory) <> "" Then
Kill sDir & "\*.*"
RmDir sDir
End If
olAtt.SaveAsFile sFile
'Прописать путь к winrar.exe
Shell "C:\Program Files\WinRAR\winrar.exe e " & sFile & " " & sDir & "\"
strFileName = Dir(sDir & "\" & "*.*")

Do While strFileName <> "" 'До тех пор пока файлы "не закончатся"
'MsgBox strFileName
str2 = Split(strFileName, ".")
sFileType2 = "." & LCase(str2(UBound(str2)))
Select Case sFileType2
Case ".xls", ".xlsx", ".doc", ".docx"
ShellExecute 0, "print", sDir & "\" & strFileName, vbNullString, vbNullString, 0
Case ".pdf"
'Прописать путь к AcroRd32.exe
Shell "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe /p /h " & sDir & "\" & strFileName
Case ".jpg", ".png"
sFile = sDirectory & "FileForPrint_" & olAtt.Index & sFileType
olAtt.SaveAsFile sFile
'Прописать путь к mspaint.exe
Shell "C:\WINDOWS\system32\mspaint.ex e " & sDir & "\" & strFileName & " /p"
End Select
strFileName = Dir 'Следующий файл
Loop
End Select
Next
End If
End Sub

'Процедура печать текста письма
Private Sub PrintMessage(sDir)
On Error Resume Next
ShellExecute 0, "Print", sDir, vbNullString, "", 1
End Sub


Public Sub PrintMessageAndAttach(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
'Нужно создать папку, куда временно будут сохраняться письма и их вложения перед печатью (прописывается без обратного слеша в конце)
saveFolder = "C:\\Test"
If Dir(saveFolder, vbDirectory) = "" Then
MkDir saveFolder
End If

'Сообщение, которое всплывает после получения письма
'Для наглядности оно отображает Тему письма, email отправителя, и количество вложений
If MsgBox("Вы хотите распечатать входящее письмо и все его вложения?" & Chr(10) & _
"Тема: " & itm.Subject & Chr(10) & _
"Отправитель: " & itm.SenderEmailAddress & Chr(10) & _
"Вложения: " & itm.Attachments.Count, vbYesNo, "Печать письма и вложений") = vbYes Then

'Сохранение письма и его печать
itm.SaveAs (saveFolder & "\Message_For_Print.msg")
PrintMessage saveFolder & "\Message_For_Print.msg"

'Печать вложений
PrintAttachments itm

End If
End Sub
Он печатает прямо с почты, там можно подправить, печать на одном листе?

[vektorss]

спасибо

[IgorGO]

настроить печать служебного файла
импортировать в него данные из почтового файла
распечать

предполагаю, что потребуется 10-15 строк кода в общем итоге

[Aleksandr H.]

я бы вместо

ShellExecute 0, "print", sDir & "\" & strFileName, vbNullString, vbNullString, 0

написал открытие файла в ексель-подгонка параметров-закрытие файла.