VBA替换Sendkeys在打印设置中选择选项

Question

在Excel中打印时，我的工作场所还​​有一个弹出窗口，用于选择打印选项。它不是Excel的一部分（我相信它是Canon打印机对话窗口）。这些选项可让您指定以彩色，装订和分页等方式打印。它们不是excel打印选项。

过去，我使用了一个宏，该宏使用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次（进入退出屏幕按钮），然后按Enter键两次（以关闭后续的对话窗口-这是excel窗口）。明确地说-提到的“人像”配置文件是一个特定的打印机配置文件，它指定了许多选项，包括方向，双面打印，装订位置，颜色模式以及装订/分页/分页偏好。

我很高兴在可能的情况下替换所有SendKeys命令，因为我知道它们不可靠/不受支持。

[更新14.05.2019]：

因此，我研究了尝试用'Keybd_Event'代替sendkey的方法，但这遇到了完全相同的障碍（可以正常工作，直到打开打印机对话窗口）。

[更新20.05.2019]

@Selkie的解决方案有效，我已将其标记为答案。

这是我最后使用的代码，尽管仍然需要对其进行调整，以使其遍历选定的工作表：

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

Answer 1

所以这真的很棘手，我最近才设法弄清楚。

基本上，当您打开这样的窗口时，sendkeys停止工作-从Excel中开始。

解决方案？从外部调用sendkey。

这是我编写的示例代码，用于在按钮所在的页面之后的15页上将打印机类型更改为双面打印：

Sub PrinterSetUp()
Dim filepath As String
Dim Msg As Integer

'This code is super janky, I apologize.

'Filepath can't have a space in it
filepath = "Filepath\PrinterScript.vbs"
 'Select the printer we want to print to
Application.Dialogs(xlDialogPrinterSetup).Show


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 & "For i = 1 To 14" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys  " & Chr(34) & "^" & Chr(34) & "&" & Chr(34) & "{PGDN}" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "%psp" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 2500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "{TAB 1}" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "o" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 3500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "{TAB 4}" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "n" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "y" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "{TAB 2}" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "l" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "{Enter}" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 500" & vbNewLine
VBScriptString = VBScriptString & "WSHshell.SendKeys " & Chr(34) & "{Enter}" & Chr(34) & " " & vbNewLine
VBScriptString = VBScriptString & "wsh.sleep 500" & vbNewLine
VBScriptString = VBScriptString & "Next"

oFile.WriteLine VBScriptString

oFile.Close


Set fso = Nothing
Set oFile = Nothing




End Sub

工作原理：检查是否有外部VBS脚本。如果找不到它，它将编写它，然后它将使用powershell调用脚本。然后，脚本将使用Excel的“外部” sendkeys使一切正常工作-覆盖Excel固有的“不能在对话框中使用sendkeys”

在执行此操作之前，我不得不将我的标准降低很多，而且我不建议这样做。我相信，除了双面打印外，对于大多数其他事情，还有其他选择。但是，这确实使sendkey与Excel对话框配合使用，这正是您要问的。

您当然需要编辑代码以使其与sendkey一起尝试工作-一种更简单的方法是直接直接编写VBS脚本-我需要我的脚本可以在任何计算机和任何设备上工作我碰巧位于文件路径目录中，因此具有写后使用功能。

您翻译的脚本看起来像：

VBScriptString  = VBScriptString  & "    Application.SendKeys (" & Chr(34)& "%p" & Chr(34)& "), True 'Selects Page Layout" & vbnewline
VBScriptString  = VBScriptString  & "    Application.SendKeys (" & Chr(34)& "%i" & Chr(34)& "), True 'Selects Print Titles" & vbnewline
VBScriptString  = VBScriptString  & "    Application.SendKeys (" & Chr(34)& "%o" & Chr(34)& "), True 'Selects Options" & vbnewline
VBScriptString  = VBScriptString  & "    Application.SendKeys (" & Chr(34)& "p" & Chr(34)& "), True  'Selects 'Portrait' default (this needs to be set up initially)" & vbnewline
VBScriptString  = VBScriptString  & "    Application.SendKeys " & Chr(34)& "{TAB 19}" & Chr(34)& ", True 'Tabs to OK" & vbnewline
VBScriptString  = VBScriptString  & "    Application.Wait (Now() + TimeValue(" & Chr(34)& "00:00:01" & Chr(34) & "))" & vbnewline
VBScriptString  = VBScriptString  & "    Application.SendKeys " & Chr34 & "~" & Chr(34)& ", True 'Hits enter to close screen" & vbnewline
VBScriptString  = VBScriptString  & "    Application.Wait (Now() + TimeValue(" & Chr(34)& "00:00:01" & Chr(34)& "))" & vbnewline
VBScriptString  = VBScriptString  & "    Application.SendKeys " & Chr(34)& "~" & Chr(34)& ", True 'Hits enter to close screen" & vbnewline

当然，您可能要使用默认方法：

Worksheets("Sheet1").PageSetup.Orientation = xlPortrait

这是在纵向模式下进行单页打印的简便方法