こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

投稿日時 - 2007-02-25 18:38:40

QNo.2783388

すぐに回答ほしいです

質問者が選んだベストアンサー

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

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

投稿日時 - 2007-03-14 10:31:17

お礼

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

投稿日時 - 2007-03-17 22:35:32

このQ&Aは役に立ちましたか?

7人が「このQ&Aが役に立った」と投票しています

回答(11)

ANo.11

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

投稿日時 - 2007-03-18 11:46:40

お礼

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

投稿日時 - 2007-03-19 22:36:13

ANo.9

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

さてと、
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の終了処理が不要になりますので・・

投稿日時 - 2007-03-07 14:12:05

お礼

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

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("番号")”
の部分に戻る事はできないのでしょうか?
宜しくお願いします。

投稿日時 - 2007-03-12 13:49:55

ANo.8

だからぁ・・・。今、 かなりイライラしています。
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 では印刷されます。
という問題がありましたよね?
回答する場合は極力汎用性のあるものを提示したいのですが、
これは中々難しいものがあります。
ですので、私も無駄にスレを伸ばしたくないので、「バージョンは何ですか?」と尋ねています。

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

投稿日時 - 2007-03-03 22:03:12

補足

遅くなってすいません。
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

投稿日時 - 2007-03-06 23:36:51

お礼

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

投稿日時 - 2007-03-06 23:41:07

ANo.7

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

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

投稿日時 - 2007-03-03 11:55:54

お礼

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

投稿日時 - 2007-03-03 16:37:13

ANo.6

では早速前レスを参考にして
前略
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のバージョン?

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

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

投稿日時 - 2007-03-02 01:30:37

お礼

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

投稿日時 - 2007-03-03 01:48:03

ANo.5

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

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

ヘルプを見てみる。
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 を自動的に閉じる方法で確実なものが分かりません
印刷の途中で紙切れやトナー切れで他のプリンタをデフォルトプリンタに切り替えた場合
エラーになっているプリンタのジョブをどう処理するか?などなど・・・

投稿日時 - 2007-02-28 01:21:46

補足

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

投稿日時 - 2007-03-01 22:48:06

ANo.4

こんにちは。
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は最後の条件判定文(ない場合もあります)

投稿日時 - 2007-02-26 16:46:30

お礼

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

投稿日時 - 2007-02-26 23:23:36

ANo.3

前半だけです。(^^ゞ
後半はきっちりやろうとすると難し~。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

投稿日時 - 2007-02-26 13:05:22

補足

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

投稿日時 - 2007-02-26 23:25:34

ANo.2

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

投稿日時 - 2007-02-25 23:13:59

補足

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

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

投稿日時 - 2007-02-26 12:18:42

ANo.1

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

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

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

投稿日時 - 2007-02-25 18:56:36

あなたにオススメの質問