VBA 将 Sendkeys 替换为打印设置中的 select 选项
VBA Replace Sendkeys to select option in print settings
在 Excel 中打印时，我的工作场所有一个额外的弹出窗口 window 用于 select 打印选项。它不是 Excel 的一部分（我相信它是佳能打印机对话 window）。这些选项允许您指定以彩色、装订和整理等方式打印。它们不是 excel 打印选项。
过去，我使用了一个宏，该宏使用 SendKeys 来复制用于 select（在 Excel 中）页面布局（alt P）、页面设置的键盘快捷键(alt I)，然后在页面设置屏幕 (alt O) 中 'Options'。 selecting 'Options' 后，打印机对话屏幕打开，宏继续使用 SendKeys 到 select 此 window 中的配置文件（每个配置文件包含选项彩色打印、装订和整理等）。这段代码如下：
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 在单独的打印机 window 打开时失败（特别是在以 Application.SendKeys ("p"), True 开头的行超越）。基本上，宏将打开打印机设置 window 但之后什么都不做。
我曾尝试寻找 SendKeys 的替代品，但我正在努力了解如何通过 VBA - 自动完成点击 p (selects 肖像profile in print dialogue window), 按 Tab 键 19 次（到达退出屏幕按钮），然后按 enter 键两次（关闭后续对话 windows - excel windows).要清楚 - 提到的 'portrait' 配置文件是一个特定的打印机配置文件，它指定了许多选项，包括方向、2 面打印、装订位置、颜色模式和 staple/collate/group 首选项。
如果可能的话，我很乐意替换所有 SendKeys 命令，因为我知道它们不是 reliable/supported。
[2019 年 5 月 14 日更新]：
所以我研究了尝试用 'Keybd_Event' 替换发送键，但这遇到了完全相同的障碍（在打印机对话框 window 打开之前一直有效）。
[更新 2019 年 5 月 20 日]
@Selkie 的解决方案有效，我已将其标记为答案。
这是我最后使用的代码，尽管仍然需要对其进行调整以使其循环遍历 selected 工作表：
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
所以这真的很棘手，我最近才弄明白。
基本上，当您像那样打开 window 时，sendkeys 停止工作 - 来自 Excel。
解决办法？从外部调用发送键。
这是我在按钮所在的 sheet 之后的 15 sheet 秒将打印机类型更改为双面打印的示例代码：
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 "externally" 使一切正常工作 - 覆盖 Excel 的固有 "Can't use sendkeys for dialogs"
在能够做到这一点之前，我不得不降低我的标准，我不推荐它。我相信除了双面打印之外，大多数情况下还有其他选择。但是，这确实使 sendkeys 与 Excel 对话框一起工作，这就是您要问的。
您当然需要编辑代码以实现您尝试使用发送键执行的操作 - 一种更简单的方法是直接编写 VBS 脚本 - 我需要我的脚本在任何计算机上工作以及我碰巧所在的任何文件路径目录，因此具有 write-then-use 功能。
你翻译的脚本看起来像这样：
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
这是制作 sheet 纵向模式打印的更简单方法
在 Excel 中打印时，我的工作场所有一个额外的弹出窗口 window 用于 select 打印选项。它不是 Excel 的一部分（我相信它是佳能打印机对话 window）。这些选项允许您指定以彩色、装订和整理等方式打印。它们不是 excel 打印选项。
过去，我使用了一个宏，该宏使用 SendKeys 来复制用于 select（在 Excel 中）页面布局（alt P）、页面设置的键盘快捷键(alt I)，然后在页面设置屏幕 (alt O) 中 'Options'。 selecting 'Options' 后，打印机对话屏幕打开，宏继续使用 SendKeys 到 select 此 window 中的配置文件（每个配置文件包含选项彩色打印、装订和整理等）。这段代码如下：
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 在单独的打印机 window 打开时失败（特别是在以 Application.SendKeys ("p"), True 开头的行超越）。基本上，宏将打开打印机设置 window 但之后什么都不做。
我曾尝试寻找 SendKeys 的替代品，但我正在努力了解如何通过 VBA - 自动完成点击 p (selects 肖像profile in print dialogue window), 按 Tab 键 19 次（到达退出屏幕按钮），然后按 enter 键两次（关闭后续对话 windows - excel windows).要清楚 - 提到的 'portrait' 配置文件是一个特定的打印机配置文件，它指定了许多选项，包括方向、2 面打印、装订位置、颜色模式和 staple/collate/group 首选项。
如果可能的话，我很乐意替换所有 SendKeys 命令，因为我知道它们不是 reliable/supported。
[2019 年 5 月 14 日更新]：
所以我研究了尝试用 'Keybd_Event' 替换发送键，但这遇到了完全相同的障碍（在打印机对话框 window 打开之前一直有效）。
[更新 2019 年 5 月 20 日]
@Selkie 的解决方案有效，我已将其标记为答案。
这是我最后使用的代码，尽管仍然需要对其进行调整以使其循环遍历 selected 工作表：
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
所以这真的很棘手，我最近才弄明白。
基本上，当您像那样打开 window 时，sendkeys 停止工作 - 来自 Excel。
解决办法？从外部调用发送键。
这是我在按钮所在的 sheet 之后的 15 sheet 秒将打印机类型更改为双面打印的示例代码：
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 "externally" 使一切正常工作 - 覆盖 Excel 的固有 "Can't use sendkeys for dialogs"
在能够做到这一点之前，我不得不降低我的标准，我不推荐它。我相信除了双面打印之外，大多数情况下还有其他选择。但是，这确实使 sendkeys 与 Excel 对话框一起工作，这就是您要问的。
您当然需要编辑代码以实现您尝试使用发送键执行的操作 - 一种更简单的方法是直接编写 VBS 脚本 - 我需要我的脚本在任何计算机上工作以及我碰巧所在的任何文件路径目录，因此具有 write-then-use 功能。
你翻译的脚本看起来像这样：
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
这是制作 sheet 纵向模式打印的更简单方法