При печати в Excel мое рабочее место имеет дополнительное всплывающее окно для выбора параметров печати. Он не является частью Excel (я считаю, что это диалоговое окно принтера canon). Эти параметры позволяют указать цветную печать, сшивание, сортировку и т. Д. Они не являются превосходными параметрами печати.
В прошлом я использовал макрос, который использует SendKeys для репликации сочетаний клавиш, используемых для выбора (в Excel) макета страницы (alt P), настройки страницы (alt I), а затем «Параметры» в Экран настройки страницы (alt O). После выбора «Опции» открывается диалоговое окно принтера, и макрос продолжает использовать SendKeys для выбора профиля в этом окне (каждый профиль содержит параметры для цветной печати, сшивания, сортировки и т. Д.). Код выглядит следующим образом:
Sub Test()
Application.SendKeys ("%p"), True 'Selects Page Layout
Application.SendKeys ("%i"), True 'Selects Print Titles
Application.SendKeys ("%o"), True 'Selects Options
Application.SendKeys ("p"), True 'Selects 'Portrait' default (this needs to be set up initially)
Application.SendKeys "{TAB 19}", True 'Tabs to OK
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "~", True 'Hits enter to close screen
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "~", True 'Hits enter to close screen
End Sub
После перехода на Windows 10 / Office 2016 - сбой SendKeys происходит в том месте, где открывается отдельное окно принтера (в частности, в строке, начинающейся с Application.SendKeys ("p"), True и далее). По сути, макрос откроет окно настроек принтера, но после этого ничего не сделает.
Я пытался найти замену SendKeys, но я пытаюсь понять, как я могу - с помощью VBA - автоматизировать процесс, чтобы нажать p (выбирает портретный профиль в диалоговом окне печати), нажать вкладку 19 раз (чтобы нажмите кнопку выхода на экран) и дважды нажмите клавишу ввода (чтобы закрыть последующие диалоговые окна, которые являются окнами Excel). Для ясности - упомянутый профиль «портрет» - это особый профиль принтера, который определяет ряд параметров, включая ориентацию, двустороннюю печать, место переплета, цветовой режим и предпочтение сшивания / сортировки / группировки.
Я был бы рад заменить все команды SendKeys, если это возможно, так как я понимаю, что они не надежны / не поддерживаются.
[Обновление 14.05.2019]:
Итак, я попытался заменить sendkeys на 'Keybd_Event' вместо этого, но это натолкнулось на тот же самый блокпост (работает до тех пор, пока не откроется диалоговое окно принтера).
[Обновление 20.05.2019]
@ Решение Селки сработало, и я пометил его как ответ.
Это был код, который я использовал в конце, хотя все еще нужно настроить его так, чтобы он проходил по выбранным листам:
Sub PrinterSetUp()
Dim filepath As String
Dim Msg As Integer
'Filepath can't have a space in it
filepath = "Directory\PrinterScriptPortrait.vbs"
If Dir(filepath) <> "" Then
'Hurray it exists
Else
'It doesn't exist yet, create the file
WriteVBSScript (filepath)
End If
Shell "wscript " & filepath, vbNormalFocus
'no code after here, otherwise everything breaks.
End Sub
Sub WriteVBSScript(filepath As String)
Dim VBScriptString As String
Dim fso As Object
Dim oFile As Object
'Needs to be done as a VBS script because VBA and sendkeys don't play well with dialog boxes.
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.CreateTextFile(filepath)
VBScriptString = VBScriptString & "Set WSHShell = WScript.CreateObject( " & Chr(34) & "WScript.Shell" & Chr(34) & " )" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.AppActivate " & Chr(34) & " Excel.exe " & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "%p" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "%i" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "%o" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "p" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "{TAB 19}" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "~" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "~" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 1000" & vbNewLine
oFile.WriteLine VBScriptString
oFile.Close
Set fso = Nothing
Set oFile = Nothing
End Sub