excel - VBA 替换 Sendkeys 以选择打印设置中的选项

Question

在 Excel 中打印时，我的工作场所有一个额外的弹出窗口用于选择打印选项。它不是 Excel 的一部分(我相信它是佳能打印机对话窗口)。这些选项允许您指定以彩色、装订和逐份打印等方式打印。它们不是 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") 开头的行处，真实 及以上)。基本上，宏将打开打印机设置窗口，但此后不执行任何操作。

我曾尝试寻找 SendKeys 的替代品，但我很难理解如何通过 VBA 自动执行点击 p 的过程(在打印对话窗口中选择纵向配置文件)，点击按 T​​ab 19 次(到达退出屏幕按钮)，然后按 Enter 两次(关闭后续对话窗口 - 即 Excel 窗口)。需要明确的是，提到的“纵向”配置文件是一个特定的打印机配置文件，它指定了许多选项，包括方向、双面打印、装订位置、颜色模式和装订/分页/分组首选项。

如果可能的话，我很乐意替换所有 SendKeys 命令，因为我知道它们不可靠/不受支持。

[2019 年 5 月 14 日更新]:

因此，我尝试将 sendkeys 替换为“Keybd_Event”，但这遇到了完全相同的障碍(在打印机对话窗口打开之前一直有效)。

[2019年5月20日更新]

@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 中。

解决方案？外部调用sendkeys。

下面是我编写的示例代码，用于将打印机类型更改为在按钮所在纸张之后的 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”

在能够做到这一点之前，我必须将我的标准降低很多，而且我不推荐这样做。我相信除了双面打印之外，大多数事情还有其他选择。但是，这确实使 sendkeys 可以与 Excel 对话框一起使用，这正是您所询问的。

您当然需要编辑代码以实现您想要使用发送键执行的操作 - 一种更简单的方法是直接编写 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

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