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

Question

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

End Sub

nicotinism · Accepted Answer

追伸
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でプリンタ設定の操作のヒントを得られるかも？
私からは此処までです。

end-u · Answer

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

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

end-u · Answer

せめて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を調整しながら試してみてください。

end-u · Answer

途中から失礼します。

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

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

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

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

DOUGLAS_ · Answer

#4 DOUGLAS_ です。

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

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

前回答は取り下げます。

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

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

DOUGLAS_ · Answer

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

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

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

これを踏まえて、[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

nicotinism · Answer

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

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

notnot · Answer

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

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

追伸

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

せめてSendKeysの確度を少しでも上げようとする案として、

途中から失礼します。

#4 DOUGLAS_ です。

＞出力する都度設定をはずさなければならない仕様になっております。

ある程度はプリンターのプロパティを操作できるようです。

同じプリンタをもう一つ「プリンタの追加」で作って設定値を変えておけば良いだけではないかと思います。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング