Search code examples
excelvbasendkeys

VBA Replace Sendkeys to select option in print settings

When printing in Excel, my workplace has an additional pop up window for selecting print options. It is not part of Excel (I believe it is a canon printer dialogue window). These options allow you to specify to print in colour, staple and collate etc. They are not excel print options.

Printer dialogue window

In the past, I have used a macro which uses SendKeys to replicate the keyboard shortcuts used to select (in Excel) Page Layout (alt P), Page Setup (alt I), and then 'Options' in the Page Setup screen (alt O). Once selecting 'Options', the printer dialogue screen opens and the macro continued to use SendKeys to select the profile in this window (each profile contains options to print in colour, staple and collate etc). The piece of code is as follows:

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

Since moving to Windows 10/Office 2016 - the SendKeys fails at the point where the separate printer window opens (specifically at the line starting with Application.SendKeys ("p"), True and beyond). Basically, the macro will open up the printer settings window but do nothing after that.

I have tried looking for a replacement to SendKeys, but I am struggling to understand how I can - via VBA - automate the process to hit p (selects portrait profile in print dialogue window), hit tab 19 times (to get to the exit screen button), and hit enter twice (to close subsequent dialogue windows - which are excel windows). To be clear - the 'portrait' profile mentioned is a specific printer profile which specifies a number of options including orientation, 2 sided printing, binding location, color mode and the staple/collate/group preference.

I would be quite happy to replace all of the SendKeys commands if possible as I understand they are not reliable/supported.

[Update 14.05.2019]:

So I've looked into trying to replace the sendkeys with 'Keybd_Event' instead, but this hits exactly the same roadblock (works right until the printer dialogue window opens).

[Update 20.05.2019]

@Selkie's solution worked, and I have marked it as the answer.

This was the code that I used in the end, although still need to tweak it so that it loops through selected sheets:

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
Solution

  • So this is really tricky, and I only recently managed to figure it out.

    Basically, when you open up a window like that, sendkeys stops working - from Excel.

    The solution? Invoke the sendkeys externally.

    Here's a sample code that I wrote to change the printer type to Duplex printing on the 15 sheets after the sheet where the button is located:

    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

    How it works: It checks that there's an external VBS script. If it doesn't find it, it'll write it, then it'll use powershell to invoke the script. The script will then use sendkeys "externally" from Excel to make everything work - overriding Excel's innate "Can't use sendkeys for dialogs"

    I had to lower my standards pretty far down before being able to do this, and I don't recommend it. I believe for most everything besides duplex printing, there are other options. However, this does make sendkeys work with Excel dialogs, which is what you were asking about.

    You will of course need to edit the code to work for what you're trying to do with the sendkeys - an easier way would be to simply write the VBS script directly - I needed my script to work on whatever computer and whatever filepath directory I happened to be on, hence the write-then-use features.

    Your script translated would look something like:

    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

    Of course, you might want to use the default method:

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

    This is a much easier way to make a sheet print in portrait mode