【sendkeysメソッドが動かずに苦慮しております】

質問

【sendkeysメソッドが動かずに苦慮しております】

OS：2000
Excel：2003
VB：6.5

こんにちは。
sendkeysメソッドが動かずに苦慮しております。
ネットでいろいろ調べてみましたが、やはり正常に動かすのは難しい様です。
実際、何をしたいのかと言うとプリンターの出力時の設定を変更したいと思っております。
会社のプリンターですが方針でデフォルトが「両面」「２分割」で設定されております。
ただ複数ファイルの跨ったプレゼン資料などを大量に出力する際は「片面」「分割なし」
で設定を変更してプリントアウトしたいと思っており、いろいろ調べた結果Sendkeysを
使うことにいたしました。
ただ、先に申し上げた通りsendkeysメソッドが動かず悩んでおります。
素人の不躾けなご質問で大変申し訳ありませんが、解決できる方法をご存知の方ご教授ください。
sendkeysメソッドを使わない方法でも問題ありません。
以下、ダイアログを表示させ、タブを移動させるまでのコードです。
それではどうぞよろしくお願いいたします。

Sub AAA()

Dim FOS As FileSystemObject
Dim FolderC As Folder
Dim FilesC As Files
Dim FileC As File
Dim FileName, Path_Name As String

Set FOS = CreateObject("scripting.filesystemobject")
Set FolderC = FOS.GetFolder("C:\Documents and Settings\AAAAA\デスクトップ\TEST")
Set FilesC = FolderC.Files

Path_Name = "C:\Documents and Settings\AAAAA\デスクトップ\TEST\"

For Each FileC In FilesC

FileName = FileC.Name

Workbooks.Open FileName:=Path_Name & FileName
ActiveWorkbook.Worksheets(1).Select

With Application
.SendKeys "^{P}", True
.SendKeys "%r", True
.SendKeys "^{tab}", True
.SendKeys "{tab 3}", True
End With

ActiveWorkbook.Close False

Next

Set FOS = Nothing

End Sub

回答No.3

nicotinism · ベストアンサー

追伸
Domain環境下か何かですかね？
プリンタの追加（インストール）が出来ないとなると・・・。出来ないんですよね？
SendKeysは正直当てにあてにならないことがたまに有って使いたくないのですが
適当に時間稼ぎを入れてみては？
標準モジュールに下記をコピペ
'ミリセカンドで停止 sleep 300 など
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
で
Sub AAAのSendKeysの前後行にSleep 500 とか適当にいれて様子を見てください。

余談ですが
SendKeysの代わりにAPIを使って行う方法も有るようです。
『keybd_event Lib "user32"』でGoogleって見てください。
今回の件に関して有効かどうかは分かりません。
あとは会員制（無料）ですが『moug』でお尋ねされるとか？同じくGoogleにて検索
APIでプリンタ設定の操作のヒントを得られるかも？
私からは此処までです。

回答No.8

end-u

testが動くようだったら、以下のように組み込めば良いです。

'同じ標準Moduleに
Sub AAA()
　　'一時的に切り替えるダミープリンタ
　　Const dummyP = "EPSON LPS7000 on Ne00:"
　　'デフォルトプリンタ。ポート番号も必要
　　Const defltP = "EPSON LPS8000 on Ne01:"
　　Dim FSO　　　 As FileSystemObject
　　Dim FilesC　　As Files
　　Dim FileC　　 As File
　　Dim Path_Name As String

　　Call test

　　If Len(ret) > 0 Then
　　　　MsgBox ret
　　　　ret = ""
　　　　Exit Sub
　　End If

　　Path_Name = "C:\Documents and Settings\AAAAA\デスクトップ\TEST\"
　　Set FSO = New FileSystemObject
　　Set FilesC = FSO.GetFolder(Path_Name).Files
　　For Each FileC In FilesC
　　　　If LCase(FSO.GetExtensionName(FileC)) = "xls" Then
　　　　　　With Workbooks.Open(FileName:=FileC.Path)
　　　　　　　　Application.ActivePrinter = dummyP
　　　　　　　　Application.ActivePrinter = defltP
　　　　　　　　'印刷処理
　　　　　　　　.Close False
　　　　　　End With
　　　　End If
　　Next

　　Set FilesC = Nothing
　　Set FSO = Nothing
End Sub

環境によってはダメかもしれないので別アプローチを検討してください。
#特にシンクライアントの環境は経験ないのでこれ以上は難しいです。

回答No.7

end-u

せめてSendKeysの確度を少しでも上げようとする案として、
コントロールパネルの[プリンタ]から設定を変えてしまう事が考えられます。
その場合はExcelのダイアログではないので
SendKeysの引数wait:=trueが効きます。
最初に１度変更して、ファイルのLoop時にはActivePrinterを
切り替えれば良いです。

'標準Module
Option Explicit

Private Declare Sub Sleep Lib "kernel32" ( _
　　　　　　　　　　　　　ByVal dwMilliseconds As Long)

Private Declare Function FindWindowA Lib "user32.dll" ( _
　　　　　　　　　　　　　　　　　　 ByVal cnm As String, _
　　　　　　　　　　　　　　　　　　 ByVal cap As String) As Long

Private ret As String

Sub test()
　　'デフォルトプリンタの登録名が必要
　　Const pName = "EPSON LPS8000"
　　'Waitタイム。単位はミリ秒
　　Const w　As Long = 50
　　Dim hWnd As Long
　　Dim i　　As Long
　　Dim t　　As Single
　　Dim x, xi, key

　　On Error GoTo extLine
　　t = Timer
　　'エクスプローラのプリンタItem
　　Set x = CreateObject("Shell.Application").Namespace(4).Items()
　　'OSによってはダイレクトに取得できないためLoop
　　For Each xi In x
　　　　If xi.Name = pName Then Exit For
　　Next
　　If xi Is Nothing Then
　　　　ret = "失敗"
　　　　GoTo extLine
　　End If
　　'印刷設定ダイアログを開く。WinXPは"印刷設定(&E)..."
　　xi.InvokeVerb "印刷設定(&T)..."
　　While hWnd = 0
　　　　DoEvents
　　　　hWnd = FindWindowA("#32770", pName & " 印刷設定")
　　　　'待ちきれなかったらerrorと見做して抜ける。暫定で10秒。
　　　　If Timer - t > 10 Then ret = "err1": GoTo extLine
　　Wend

　　'以降、SendKeys処理。タブ切替のWaitは長め
　　DoEvents
　　For i = 1 To 2
　　　　Sleep 500
　　　　SendKeys "^{pgdn}", True
　　Next
　　Sleep 500

　　For Each key In Array("{tab}", "{tab}", "{tab}", "{pgup}", "{down}") ', "{enter}")
　　　　SendKeys key, True
　　　　Sleep w
　　Next

　　'念のため終了チェック
　　While hWnd <> 0
　　　　DoEvents
　　　　hWnd = FindWindowA("#32770", pName & " 印刷設定")
　　　　'待ちきれなかったらerrorと見做して抜ける。
　　　　If Timer - t > 10 Then ret = "err2": GoTo extLine
　　Wend

extLine:
　　Set xi = Nothing
　　Set x = Nothing
　　If Err.Number <> 0 Then ret = Err.Number & ":" & Err.Description
　　MsgBox ret '本稼動では不要
End Sub

まずはtestで動くかどうか、Waitを調整しながら試してみてください。

回答No.6

end-u

途中から失礼します。

今回のようなケースで、SendKeysの引数waitをtrueにした場合は
最初のダイアログが閉じられないと次のキーストロークが送られません。

SendKeys "^p"
SendKeys "%r"
SendKeys "^{tab}"
SendKeys "{tab 3}"

あるいは
SendKeys "^p%r^{tab}{tab 3}"
などではどうでしょうか。
まずは単独ファイルで確認してみてください。

ただ、SendKeysの確実性は低いですから推奨してるわけではありません。
Loop処理はさらに厳しいんじゃないかと思いますけれども。

回答No.5

DOUGLAS_

#4 DOUGLAS_ です。

　前回答に、
＞エクセル を終了するか、改めて、プリンタ の プロパティ に
＞変更を加えるまで、最初の変更が生きているかと存じます。
と書きましたが、全くの私の勘違いでしたね。

　大変、失礼いたしました。　　<(_ _)>

　前回答は取り下げます。

＃が、一つ不思議に思うことがあるのですが、一旦 プリンタ の プロパティ を変更して印刷すると、その ブック を保存、終了して、再度開いたときに、閉じる前に設定した プリンタ の プロパティ の設定が生きているように存じますが、これは、一体どこに、その情報が保存されているのでしょうかねぇ？

＃上記がホントなら、
"C:\Documents and Settings\AAAAA\デスクトップ\TEST\"
内の ファイル を保存する前に、プリンタ の プロパティ を変更してから保存するようにしておくと、再度開いたときに、ブック ごとの「変更が生きている」というようなことにもなりそうですが。。。（これまた、不確かな情報です）。

回答No.4

DOUGLAS_

＞出力する都度設定をはずさなければならない仕様になっております。
　「都度」とは言え、エクセル が起動している時点で、一旦 プリンタ の プロパティ に変更を加えた場合は、その エクセル を終了するか、改めて、プリンタ の プロパティ に変更を加えるまで、最初の変更が生きているかと存じます。

　従って、ファイル を開いた「都度」に プリンタ の プロパティ を設定しなくても、一番最初に設定しておけばよいかと存じますが、いかがでしょうか？

--------------------------------

　これを踏まえて、[SendKeys メソッド] の ヘルプ に

-- これより ヘルプより引用 -----------------------
SendKeys メソッドは、キー コードをキー バッファに入れます。そのため、キー コードを使うメソッドを呼び出す前に、SendKeys メソッドを呼び出さなくてはならない場合があります。たとえば、パスワードをダイアログ ボックスに送るときには、ダイアログ ボックスを表示する前に SendKeys メソッドを呼び出す必要があります。
-- ここまで ヘルプより引用 -----------------------

と書いてありますように、

＞キー コードを使うメソッドを呼び出す前に、
＞SendKeys メソッドを呼び出さなくてはならない

かと存じます。

　従って、
End With
の後に、
ActiveWorkbook.Activate
DoEvents
とでもしてやれば動きそうな気がいたします。

--------------------------------

　ちなみに、
.SendKeys "{tab 3}", True
で [SendKeys メソッド] が終了しておりますが、最終的に
End With
の前が
.SendKeys "{Enter}", True
というようなことになっていなければ、いけないかと存じます。

--------------------------------

　ということで、

＞今回の件はちょっと諦めなければならないかもしれません。
とのことですが、最後に、下記でお試しになってみてください。

--------------------------------

Option Explicit

Sub AAA()
　Dim FOS As FileSystemObject
　Dim FolderC As Folder
　Dim FilesC As Files
　Dim FileC As File
　Dim FileName, Path_Name As String

　Path_Name = "C:\Documents and Settings\AAAAA\デスクトップ\TEST\"
　Set FOS = CreateObject("scripting.filesystemobject")
　Set FolderC = FOS.GetFolder(Path_Name)
　Set FilesC = FolderC.Files

　With Application
　　.SendKeys "%fp", True
　　.SendKeys "%r", True
　　.SendKeys "^{tab}", True
　　.SendKeys "{tab 3}", True
　　.SendKeys "{UP}", True
　　'ここに変更すべき点について [SendKeys メソッド] の記述が入ります。
　　.SendKeys "{Enter}", True
　　'この セクションは、プリンタ の プロパティ の変更だけですので、最後に [ESC] を送ります。
　　.SendKeys "{ESC}", True
　End With

　'キー コードを使うメソッドの呼び出し
　ActiveWorkbook.Activate
　DoEvents

　For Each FileC In FilesC
　　FileName = FileC.Name
　　Workbooks.Open FileName:=Path_Name & FileName
　　ActiveWorkbook.Worksheets(1).Select
　　'ここに、普通に印刷する コード を書いてください。
　　ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
　　ActiveWorkbook.Close False
　Next
　Set FOS = Nothing
End Sub

回答No.2

nicotinism

ある程度はプリンターのプロパティを操作できるようです。
ページ詳細設定
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv211.html#5
上記のページにもありますが、両面・片面などになるとSendKeysに頼らざるを
得ないようです。
他に方法もあるかもしれませんけど。

安直な方法なのですが
登録してあるプリンターを手動でもう1個インストールします。
するとプリンタ名(コピー1)という名前で登録されますので
このプリンターのプロパティをお望みのように変更します。
でExcelから
Application.ActivePrinter = "プリンタ名(コピー1) on LPT1"
などで切り替えてやれば出来るかも？
プリンター名はイミディエイトウィンドウで?Application.ActivePrinter
で得られるものを参考にしてください。
環境がまったく異なるので参考までに。当方WinXP & Acc2002 & 昔のプリンタ

お礼

nicotinism様

こんにちは。
早々にご回答いただきどうもありがとうございました。
プリンタの件ですが、新クライアント内に設定されているプリンタで
紙の無駄遣いを避けるべくデフォルトが集約・両面で設定されており
出力する都度設定をはずさなければならない仕様になっております。
教えていただいた方法はとても有益でしたので何か別の機会に活用させて
いただきます。
この度はどうもありがとうございました。

回答No.1

notnot

同じプリンタをもう一つ「プリンタの追加」で作って設定値を変えておけば良いだけではないかと思います。
わたしは、カラー印刷用と白黒印刷用と２つ作ってます。

お礼

notnot様

こんにちは。
ご回答いただきどうもありがとうございました。
他にご回答いただいた方にもお伝えしたのですが、今回のプリンタ
の件ですが、新クライアント内に設定されているプリンタで
紙の無駄遣いを避けるべくデフォルトが集約・両面で設定されており
出力する都度設定をはずさなければならない仕様になっております。
なのでプリンタの追加もできない環境なのです(ToT)
いろいろ調べたのですが今回の件はちょっと諦めなければならないかもしれません。
もう少し調査してみたいと思います。
この度はどうもありがとうございました。