|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
15.12.2016, 16:15 | #1 |
Новичок
Джуниор
Регистрация: 15.12.2016
Сообщений: 3
|
печать листов excel с почты
Как выставить по умолчанию на вновь создаваемые листы excel в параметрах страницы , разместить не более чем на одном листе? С шаблонами не получается, макрос тоже...
Мне приходит письмо в outlook с вложенным файлом , при его распечатке постоянно приходится входить и менять параметры.. |
15.12.2016, 16:33 | #2 |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,858
|
Макрос можно написать
Один раз вручную настроить не получится, - эти опции сохраняются внутри файла (у каждого файла свои), и файл каждый раз новый |
15.12.2016, 16:35 | #3 |
2 the Nation Glory
Старожил
Регистрация: 27.05.2014
Сообщений: 3,289
|
EducatedFool, а в Personal прописать не сработает?
Код:
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы. |
15.12.2016, 16:40 | #4 | |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,858
|
Цитата:
+ нужен код перехвата событий приложения + этот код автоматически не всегда будет срабатывать (после некоторых действий в Excel, переменные очищаются) PS: лично я бы сделал кнопку с макросом, как вы сделали |
|
15.12.2016, 16:51 | #5 |
Новичок
Джуниор
Регистрация: 15.12.2016
Сообщений: 3
|
Сейчас попробую вставить его. Пожалуйста посмотрите этот макрос:
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 Он печатает прямо с почты, там можно подправить, печать на одном листе? |
15.12.2016, 16:51 | #6 |
Новичок
Джуниор
Регистрация: 15.12.2016
Сообщений: 3
|
спасибо
|
15.12.2016, 17:04 | #7 |
Новичок
СтарожилДжуниор
Регистрация: 05.02.2008
Сообщений: 9,487
|
настроить печать служебного файла
импортировать в него данные из почтового файла распечать предполагаю, что потребуется 10-15 строк кода в общем итоге
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
|
15.12.2016, 17:05 | #8 |
2 the Nation Glory
Старожил
Регистрация: 27.05.2014
Сообщений: 3,289
|
я бы вместо
Код:
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Печать в *.pdf выбранных листов | Eugmai86 | Microsoft Office Excel | 11 | 26.03.2012 01:09 |
Печать нескольких листов в один pdf | tae1980 | Microsoft Office Excel | 24 | 26.02.2012 19:37 |
печать листов excel | ара | Помощь студентам | 10 | 07.04.2010 10:12 |
Сборная печать с разный листов | shafer | Microsoft Office Excel | 10 | 21.05.2008 22:06 |
печать нескольких листов | checkbox | Microsoft Office Excel | 2 | 16.01.2008 00:50 |