vba初心者

質問

いつもお世話様です。
A列にあらかじめデータを入れといてinboxでデータを検索してもしあったらPDFファイルを開いて印刷でもしデータがなかったらinboxに戻るかたちにしたいんですけど、do...loopの使い方が分からないのと、デバックがでてしまってどう直せばいいかわかりません。サンプルコードがあれば助かります。よろしくお願いします。

Dim a As Integer
Dim inbox As String
Dim Localpath As Variant
Dim c As Range, myFadd As String
Dim flag As Variant
Dim MyShell As Object
Dim Mysh As String
Dim newHour As Variant
Dim newMinute As Variant
Dim newSecond As Variant
Dim waitTime As Variant

Localpath = ThisWorkbook.Path

a = 1
inbox = InputBox("番号")

Do

If inbox = Empty Then
Exit Sub
End If
If inbox = Cells(a, 1) Then
MsgBox ("あります")
Exit Do
Else
a = a + 1　←ここでデバックがでてしまいます。
ElseIf Cells(a, 1) <> inbox Then
MsgBox ("ない")
End If
Loop

Set MyShell = CreateObject("WScript.Shell")
MyShell.Run ("AcroRd32.exe /n")
MyShell.Run ("AcroRd32.exe /p") & Localpath & "\" & Myfile & ".pdf"
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Application.SendKeys "{Enter}", True
'次の使用例は、10 秒を過ぎるとメッセージを表示します。
If Application.Wait(Now + TimeValue("0:00:10")) Then
MsgBox "時間が過ぎました。"
End If
End Sub

回答No.10

nicotinism · ベストアンサー

こんにちは。
以下を新規標準モジュールにコピペ

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

Sub PrintPDF(ByVal FileName As String, _
　　　　　　　　　　 Optional ByVal Copies As Long = 1)

　　Dim dtLimit As Date
　　Dim lngChannel As Long
　　Dim I As Long
　　Dim blnAlerts As Boolean

　　CreateObject("Wscript.Shell").Run "AcroRd32.exe", 7

　　dtLimit = Now() + TimeSerial(0, 0, 10) ' 起動待ちの制限時間
　　With Application
　　　　blnAlerts = .DisplayAlerts　　'DisplayAlertsを元に戻す為に初期値を記憶
　　　　.DisplayAlerts = False
　　End With
　　On Error GoTo Err_Handler
　　lngChannel = DDEInitiate("Acroview", "Control")
　　On Error GoTo 0
　　Application.DisplayAlerts = blnAlerts

　　For I = 1 To Copies
　　　　DDEExecute lngChannel, _
　　　　　　　　　　"[FilePrintSilent(""" & FileName & """)]"
　　Next
　　DDEExecute lngChannel, "[AppExit]"
　　DDETerminate lngChannel
　　Exit Sub

Err_Handler:
　　If Now() < dtLimit Then
　　　　Sleep 200
　　　　Resume
　　End If
　　Application.DisplayAlerts = blnAlerts
　　Err.Raise Err.Number, , "Adobe Readerとの通信を開始できません"

End Sub

さらに、こちらも（必ず上記コピペを先に行って下さい）

Sub PDF_Menu()
　　Dim searchNo As Variant
　　Dim searchCount As Integer
　　Dim Localpath As Variant
　　Dim MyFile As String
　　Dim strFindRange As String

　　Localpath = ThisWorkbook.Path

　　Do
　　　　searchNo = _
　　　　StrConv(InputBox("番号は？ N で終了します"), vbNarrow + vbUpperCase)
　　　　If searchNo = "N" Then Exit Sub
　　　　Do
　　　　　　searchCount = _
　　　　　　WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), searchNo)

　　　　　　Select Case searchCount
　　　　　　　　Case 0
　　　　　　　　　　MsgBox "正しい番号を入力して下さい"
　　　　　　　　　　Exit Do '外側のループに移動
　　　　　　　　Case 1
　　　　　　　　　　strFindRange = _
　　　　　　　　　　ActiveSheet.Range("A:A"). _
　　　　　　　　　　Find(what:=searchNo, Lookat:=xlWhole).Address
　　　　　　　　Case Else
　　　　　　　　　　MsgBox "同じ番号が複数登録されています"
　　　　　　　　　　Exit Do
　　　　　　End Select

　　　　　　MyFile = Localpath & "\" & Range(strFindRange).Offset(0, 1) & ".pdf"

　　　　　　If Dir(MyFile) = "" Then
　　　　　　　　MsgBox MyFile & " が見つかりません" & vbCrLf _
　　　　　　　　　　& "実際にファイルが有るか確認して下さい"
　　　　　　　　Exit Do
　　　　　　End If

　　　　　　If MsgBox(Range(strFindRange).Offset(0, 1) _
　　　　　　　　& " を印刷しますか", vbOKCancel) = vbCancel Then
　　　　　　　　Exit Do
　　　　　　End If

　　　　　　PrintPDF (MyFile)
　　　　　　Exit Do
　　　　Loop
　　Loop
End Sub

Do ～ Loopから何かしらの脱出方法がないと無限地獄に落ちてしまうので、
N キーで抜け出す事にしました。
Acrobat の終了方法で確実なものが考えられなかったので
PrintPDF は他所で発見したものを丸ごと使わせていただきました。
画面がちらつく(Reader がチラッと出てくる)のはご勘弁を。
WSH のヘルプに則っているのですが何としても出てきます。
　　CreateObject("Wscript.Shell").Run "AcroRd32.exe", 7 ←これ(7)の意味は
　　『ウィンドウを最小化ウィンドウとして表示します。アクティブなウィンドウは切り替わりません。』
　　という事になってるのですけどね？？

WSHのヘルプはこちらからダウンロードできます
http://www.microsoft.com/downloads/details.aspx?displaylang=ja&FamilyID=C717D943-7E4B-4622-86EB-95A22B832CAA
VBAではできない事を色々補ってくれます。
http://wwwroy.hi-ho.ne.jp/mutaguchi/wsh/wshtop.htm
http://www.microsoft.com/japan/technet/scriptcenter/resources/qanda/ad.mspx

お礼

ありがとうございます。
一つ質問なのですが、
>PrintPDF は他所で発見したものを丸ごと使わせていただきました。
こうのようなvbaのサンプルコードはどのように探せばよろしいでしょうか?
何かアドバイスあったらください！よろしくお願いします。

回答No.11

nicotinism

Excel関連やVisualBasic関連のHP、BBSを時間を作って（暇なとき）見る
使えそうなものはメモって置く
分からない言葉があったときに、ソフトのヘルプやGoogleで調べる
Googleで関係しそうな単語を入れて検索
　（DDE Excel VBA PDF ・・で検索したと思う）
　何を入れたら Hit しやすいかは経験とある程度の知識の蓄積が必要。
　書籍で系統立てた勉強はしておいた方が良いと思います
　つまみ食いだと結局遠回りだと思います→俺

個人運営のHPでは相互にリンク紹介しているので、
そこから自分に合いそうな所を辿る。

具体的なサイトは、Excel関連では
http://www.moug.net/index.htm
http://www.h3.dion.ne.jp/~sakatsu/
http://www.fuji.ne.jp/~excelyou/exrounge.htm
など綺羅星のごとくあります。

ちょっと道草
http://cgi30.plala.or.jp/chikada/vba/vba.shtml

お礼

ありがとうございました！
また機会がありましたら色々教えてくださいね！

回答No.9

nicotinism

えーと、少しきつい言い方をしてしまった事をお詫びいたします。
虫の居所が悪かったので、ムカッとなってしまいました。

さてと、
Do と Loop、If と End If、Select Case と End Select などは
必ずペアになっていないとエラーになりますがあってます？

Do・・ If・・ Select・・を複数使用した場合に、
必ずしもエラーが正しいメッセージを出すわけでは有りません。
End If が欠けているのに Select・・が無いといってくる場合もあります。

多分やられているとは思いますが、No3 の時の回答のように、Tab キーで
インデント（文字送り）してあると見やすくなります。

ただ、此処の掲示板は行頭のTab や 半角Spaceを無視してしまうので困ったモンです。
No3は投稿用に全角スペースに変換して行っています。

Acrobat Reader ver8 との事ですので、確認をちょっとお願いしたいのですが
MyShell.Run ("AcroRd32.exe /p ") & ・・・を
MyShell.Run ("AcroRd32.exe /T ") & ・・・とした場合は
印刷後にAcrobatは自動的に閉じますか？
その場合はAcrobatの終了処理が不要になりますので・・

お礼

遅くなってすいません。
こちらこそ勉強不足と理解不足でイライラさせてしまってすいませんでした。

Do と Loop、If と End If、Select Case と End Select などは
必ずペアになっていないといけないことは分かるのですが、特にDo と Loopの場合はどこにDoを入れればいいか分からないのです。

Do
searchNo = InputBox("番号")
If searchNo = "" Then Exit Sub
searchCount = WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), searchNo)
Select Case searchCount
Case 0
MsgBox searchNo & "が見つかりません"
Case 1
strFindRange = _
ActiveSheet.Range("A:A").Find(what:=searchNo, Lookat:=xlWhole).Address
MyFile = Range(strFindRange).Offset(0, 1)
If MsgBox(MyFile & " を印刷しますか", vbOKCancel) = vbOK Then
Exit Do
End If
Case Else
MsgBox searchNo & "が登録されてません"
End Select
Loop
(全角のやり方が分かりませんでした)

>Acrobat Reader ver8 との事ですので、確認をちょっとお願いしたいのですが
MyShell.Run ("AcroRd32.exe /p ") & ・・・を
MyShell.Run ("AcroRd32.exe /T ") & ・・・とした場合は
印刷後にAcrobatは自動的に閉じますか？
のことなのですが、Acrobatは自動的に閉じませんでした。

もう一つあるのですが、
Do
searchNo = InputBox("番号")
If searchNo = "" Then Exit Sub　←ここの部分
searchCount = WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), searchNo)
Select Case searchCount

の矢印の部分なのですが、”空白”だった場合　“Exit Sub”　になっていますがまた　“searchNo = InputBox("番号")”
の部分に戻る事はできないのでしょうか？
宜しくお願いします。

回答No.8

nicotinism

だからぁ・・・。今、 かなりイライラしています。
MyShell.Run ("AcroRd32.exe /p ") & Localpath & "\" & MyFile & ".pdf", 1
で開こうとして
> このファイルが見つかりません
となっているのでしょ？ということは、
ファイルが存在しないか、あるいはファイルのPathの渡し方に問題がある・・
またはフォルダをおいてある場所・・
もしくはPath名に解釈できない部分がある・・
と考えるのが自然でしょ？
なので
> では、開きたいPDFファイルは何処においているのですか？
と尋ねている訳です。
XLSファイルと同じフォルダ・・では話がまったく見えません！
> ファイル名= c:\documents and settings\nicotinism\my documents\例の.pdf
> などと出力されているはずですが？ ↑
　　　　　　　　　　　　　　　　　　　↑
前レスでこのように例示していても分かりませんか？
http://www.h2.dion.ne.jp/~naknak/debug.htm

OS や Excel のバージョンが異なると、モジュールの実行結果が異なることは
決して珍しいことではありません。
何かを開発しようとする場合に必ず抑えておかなくてはならない部分です。
先のレスでもAcrobatReader 6.x では印刷されないが、同 7.x では印刷されます。
という問題がありましたよね？
回答する場合は極力汎用性のあるものを提示したいのですが、
これは中々難しいものがあります。
ですので、私も無駄にスレを伸ばしたくないので、「バージョンは何ですか？」と尋ねています。

という事で、前回のレスで尋ねたことに加えて
一度問題を整理したいので、現在のモジュールをコピペして提示してください。

お礼

遅くなってすいません。
すいませんが補足のほうに入れてしまいました。

補足

遅くなってすいません。
OS 名　Microsoft Windows XP Home Edition
バージョン 5.1.2600 Service Pack 2 ビルド 2600　(excel2003)
です。ほとんどnicotinismさんのコードを使わせてもらいました。すいません。実をいうと最初自分で作ったコードも色んなサイトから拾って使ってみたものなのです。
ちょっと変えてみたのですが、このコードでpdfファイルは開けるようになりました。
原因は変数のMyFailでした
MyFailは MyFile = Range(strFindRange).Offset(0, 1)
だったのでinputboxはいったデータ(ファイル名)ではないので、ファイルが開かなかったのです。
なのでMyShell.Run ("AcroRd32.exe /p ") & Localpath & "\" & searchNo & ".pdf", 1
にしてみました。
そしたら開きました。
そこであらたにコードを付け加えてみたのですが今度は"doに対するloopがありません"となってしまいました。
どうしてでしょうか？空はだったらまたinputboxに戻りたいんですけど・・・
色々お聞きしたいことまだあるのですが、よろしいでしょうか？
何卒よろしくお願いします。

Dim searchNo As Variant
Dim searchCount As Integer

Dim Localpath As String

Dim MyShell As Object
Dim MyFile As String
Dim strTrgRange As String
Dim strFindRange As String

Dim newHour As Variant
Dim newMinute As Variant
Dim newSecond As Variant
Dim waitTime As Variant

Localpath = ThisWorkbook.Path

Do
searchNo = InputBox("番号")
If searchNo = Empty Then
MsgBox "空白です"
Else
Exit Do
End If

'Do
searchCount = WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), searchNo)

Select Case searchCount
Case 0
MsgBox searchNo & "が見つかりません"
Case 1
strFindRange = _
ActiveSheet.Range("A:A").Find(what:=searchNo, Lookat:=xlWhole).Address
MyFile = Range(strFindRange).Offset(0, 1)
If MsgBox(MyFile & " を印刷しますか", vbOKCancel) = vbOK Then
Exit Do
End If
Case Else
MsgBox searchNo & "が登録されていません"

Loop
Set MyShell = CreateObject("WScript.Shell")
MyShell.Run ("AcroRd32.exe /p ") & Localpath & "\" & searchNo & ".pdf", 1

End Sub

回答No.7

nicotinism

では、開きたいPDFファイルは何処においているのですか？
> debug.print "ファイル名= " & Localpath & "\" & MyFile & ".pdf"
これでAcrobatReaderがファイルを開こうとする前の段階で
イミディエイト ウィンドウに
ファイル名= c:\documents and settings\nicotinism\my documents\例の.pdf
などと出力されているはずですが？
イミディエイト ウィンドウは Ctrl + G でも開きます。
（分からない言葉は自身でもヘルプで調べてね！）

OSのバージョンはマイコンピュータを右クリックしてプロパティから表示されます
Excelのバージョンはヘルプからバージョン情報で。
ちょっと前途多難かな・・・

お礼

イミディエイト ウィンドウに"
実行時エラー'424':　オブジェクトが必要です"と表示されます。
開きたいpdfファイルはマクロを実行しているファイルと同じフォルダの中にあります。
＞OSのバージョンはマイコンピュータを右クリックしてプロパティから表示されます
Excelのバージョンはヘルプからバージョン情報で。
って何かvbaと関係しているのですか？

回答No.6

nicotinism

では早速前レスを参考にして
前略
Loop
debug.print "ファイル名= " & Localpath & "\" & MyFile & ".pdf" '←これを追加
Set MyShell = CreateObject("WScript.Shell")
MyShell.Run ("AcroRd32.exe /p ") & Localpath & "\" & MyFile & ".pdf", 1
後略
でイミディエイト ウィンドウ に何が表示されますか？
多分・・・と、山勘は働いていますけど一応。

> ActiveWindow.caption
↑これは、Excel の『ActiveWindow』なので、AcrobatReader は「我関せず」です。

Windows のバージョン（XP ならHome Or Proも含めて）と、ServicePackのバージョン？
Excel のバージョン と SPのバージョン？

以上三点は如何？
週末には決着したいと思っています。

なのでお礼欄に記述してもらうと、こちらに無条件でメールが入りますので
反応も早いかと思います。

お礼

わかりました。お礼欄に記述しますね！
debug.print "ファイル名= " & Localpath & "\" & MyFile & ".pdf"
これを追加しましたが、やはり”この文章の開くときにエラーが発生しました。このファイルが見つかりません”とでてしまいます。
＞Windows のバージョン（XP ならHome Or Proも含めて）と、ServicePackのバージョン？
Excel のバージョン と SPのバージョン？
の意味がちょっと分からないのですが・・・

回答No.5

nicotinism

どうやって？と言われても答えに窮してしまいますが
取りあえずは

いきなり書き始めないで、紙に流れ（アルゴリズム）を書いて考える。

ヘルプを見てみる。
Do や Loop などの所にカーソルを持って行って、F1 キーで出てきます。

ループに入る前のラインで F9 キーでブレークポイントを置いておくと
そこで止まりますので、F8キーでステップ実行して追いかける。

debug.print 変数名
でイミディエイトウィンドウに現れた値で確認する

とかでしょうか・・

なお
MyShell.Run ("AcroRd32.exe /p ") & Localpath & "\" & MyFile & ".pdf", 1 を
MyShell.Run ("AcroRd32.exe /t ") & Localpath & "\" & MyFile & ".pdf", 1 とすると

当方で確認した限りではAcobatReader7.xでは印刷まで自動的に行われるようです
6.xでは印刷されませんでした。

印刷終了後にAcrobatReader を自動的に閉じる方法で確実なものが分かりません
印刷の途中で紙切れやトナー切れで他のプリンタをデフォルトプリンタに切り替えた場合
エラーになっているプリンタのジョブをどう処理するか？などなど・・・

補足

ありがとうございます。
今AcobatReader8.xを使ってるのですが、AcobatReader8.までは開くのですが"この文章を開くときのエラーが見つかりました。このファイルが見つかりません”ってなってしまうのですが、どうしてでしょうか？
それとAcrobatReader を自動的に閉じる方法って"ActiveWindow.Close"ではだめなのでしょうか？よろしくお願いします。

回答No.4

sugao_chib

こんにちは。
if文の一般的な使い方を説明します。
(1). a = 1 の時は b = a + 1 を実行する
　if a = 1 then
　　b = a + 1
　end if
(2). a = 1 の時は b = a + 1, 左記以外は b = a - 1 を実行
　if a = 1 then
　　b = a + 1
　else
　　b = a - 1
　end if
(3). a = 1 の時は b = a + 1, a = 2 の時は b = a * 2,
　　 左記以外は b = a - 1 を実行
　if a = 1 then
　　b = a + 1
　elseif a = 2 then
　　b = a * 2
　else
　　b = a - 1
　end if
(4). a = 1 の時は b = a + 1, a = 2 の時は b = a * 2 を実行
　if a = 1 then
　　b = a + 1
　elseif a = 2 then
　　b = a * 2
　end if
となります。

・if～endifはペアで用いる(endifが最初のif文の終わり)
・elseは先行するif(またはelseif)がすべて偽の時実行される
・elseは最後の条件判定文(ない場合もあります)

お礼

ありがとうございます!
応用してやってみたいと思います。

回答No.3

nicotinism

前半だけです。(^^ゞ
後半はきっちりやろうとすると難し～。APIかWMIの出番？
（B列にファイル名があると仮定してます）

Sub PDF_Print()
Dim searchNo As Variant
Dim searchCount As Integer

Dim Localpath As String

Dim MyShell As Object
Dim MyFile As String
Dim strTrgRange As String
Dim strFindRange As String

Dim newHour As Variant
Dim newMinute As Variant
Dim newSecond As Variant
Dim waitTime As Variant

Localpath = ThisWorkbook.Path

Do
　　searchNo = InputBox("番号")
　　If searchNo = "" Then Exit Sub
　　searchCount = WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), searchNo)
　　Select Case searchCount
　　　　Case 0
　　　　　　MsgBox searchNo & "が見つかりません"
　　　　Case 1
　　　　　　strFindRange = _
　　　　　　ActiveSheet.Range("A:A").Find(what:=searchNo, Lookat:=xlWhole).Address
　　　　　　MyFile = Range(strFindRange).Offset(0, 1)
　　　　　　If MsgBox(MyFile & " を印刷しますか", vbOKCancel) = vbOK Then
　　　　　　　　Exit Do
　　　　　　End If
　　　　Case Else
　　　　　　MsgBox "同じ番号 " & searchNo & "が複数登録されています"
　　End Select
Loop

Set MyShell = CreateObject("WScript.Shell")
MyShell.Run ("AcroRd32.exe /p ") & Localpath & "\" & MyFile & ".pdf", 1

End Sub

補足

ありがとうございます。
完璧すぎるご回答感謝致します！！！
構文まで作っていただいてありがとうございました。
本当に助かりました。
do...loopの間の構文の作り方ってどうやってどうやって作っていけばいいですか？おおまかの流れは分かるのですが、一つ一つになると理解が欠けてしまいます。よろしかったら細かくなってしまうと思うのですがご指導よろしくお願いします。

回答No.2

sugao_chib

ifの構造がおかしいです。
if inbox ..
　else
　　a=a+1
　elseif
end if
else の後ろに elseif があります。

補足

Else
a = a + 1　
Cells(a, 1) <> inbox Then　←ここでデバックがでてしまいました。
MsgBox ("ない")
End If

このようにしてみたのですが、またデバックがでてきてしまいました。
elseとelseifをどこで使ったらいいかわかりません。教えて下さい。宜しくお願いします。

回答No.1

PIC-JQ

a = a + 1　←ここでデバックがでてしまいます。
ElseIf Cells(a, 1) <> inbox Then

次のようにしたらどうですか？

a = a + 1
ELse
If Cells(a, 1) <> inbox Then