ＥｘｃｅｌのVBAでエラーになるのですが

質問

最近、ＶＢＡを始めたので、よくわかっていないのですが、以下のようなマクロを書いています。（長いので、かなり省略していますが)一応、動くようになったのですが、なぜか、一旦、最初(sheet 1)に戻ってしまうことがあります。（何度か繰り返して、進みますが）
なぜなのかと考えると、該当シートが見つからないからのようなのですが、どのように対策したら良いのでしょうか？

Dim s_A As String
Sub Spec()
s_A = "1"
Call Spec3
Call Spec4
s_A = "2"
Call Spec3
Call Spec4
　　'このあと s_A = "100" まで続く
ActiveWorkbook.Close
End Sub

Sub Spec3()
On Error Resume Next
Do Until Selection.Value = ""
　　If　～　then
Else
～
Else if
～
End If
Loop
'ここで、動作を繰り返させている
End Sub

　そこで、エラー対策として、specの先頭にOn Error Resume Nextを入れるとエラーになりますよね？
　該当シートがない場合は、次のシート（３行下）にジャンプさせたいのですが。
　よろしくお願いします。

回答No.6

papayuka · ベストアンサー

#1です。
丸投げされても困ります。色々な回答、サンプルが提示されている中で、ご自身で応用するにあたって上手く行かない部分を質問されないと、答える方は何が解からないのか解かりません。ソースを見る感じでは、

1.あるフォルダ内に xx_list.xls という名前のExcelブックが多数ある。
2.上記ブックには複数のシートが存在し、それぞれのシートのセルB3～Bxxまでにファイル名が入力されている。

こんな感じに取れました。（Spec4 は危ない処理に思えます）

下記は特定フォルダ内のExcelブックを次々に開き、開いたブック内の全シートをループさせ、マクロのあるブックの1枚目のシートに Mydoc と Mydoc2 に相当するパスを記述するサンプルです。
CA_list.xls 等があるフォルダに新規ブックを作成し、下記のマクロをコピペして実行前に必ず保存します。

Sub Test()
Dim fs As FileSearch, i As Integer
Set fs = Application.FileSearch
With fs
　.NewSearch
　.LookIn = ThisWorkbook.Path
　.Filename = "*.xls"
　If .Execute() > 0 Then
　　For i = 1 To .FoundFiles.Count
　　　If .FoundFiles(i) <> ThisWorkbook.FullName Then
　　　　 Call myOpen(.FoundFiles(i))
　　　End If
　　Next i
　End If
End With
　Set fs = Nothing
End Sub

Sub myOpen(FName As String)
Dim wb As Workbook, ws As Worksheet, i As Long, cnt As Long
Dim b_A As String, Mydoc1 As String, Mydoc2 As String

Set wb = Workbooks.Open(FName)

'[_list.xls]を取り除いて b_A にセット
b_A = Left(Dir(FName), Len(Dir(FName)) - 9)

For Each ws In wb.Worksheets
　With ws
　　'↓この1行はサンプル用
　　cnt = ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Row

　　.Activate
　　For i = 3 To .Range("B65536").End(xlUp).Row
　　　Mydoc1 = "I:\GIJUTSU\SPEC\" & (b_A) & "\" & _
　　　　　　　　(.Name) & "\" & .Range("B" & i) & ".doc"
　　　Mydoc2 = "I:\GIJUTSU\PDF\spec\" & (b_A) & "\" & _
　　　　　　　　(.Name) & "\" & .Range("B" & i) & ".pdf"
　　　'ここからサンプル用
　　　ThisWorkbook.Worksheets(1).Range("A" & cnt) = Mydoc1
　　　ThisWorkbook.Worksheets(1).Range("B" & cnt) = Mydoc2
　　　cnt = cnt + 1
　　　'ここまでサンプル用
　　　'本来の処理をこのあたりに書く？
　　Next i
　End With
Next ws
　wb.Close: Set wb = Nothing
End Sub

お礼

ありがとうございました。
　お礼を書いたつもりだったのですが、アップされていないようです。失礼しました。
　例としてあげていただいたスクリプトの動作は確認しました。それを元に、もう一度最初から書き直してみたいと思います。

回答No.5

papayuka

#1です。

> 該当シートが見つからないからのようなのです
> 該当シートがない場合は、次のシート（３行下）にジャンプさせたい
> Excelのシートにあるファイルを順にPDFに変換していきます。
> で、空白セルが出てきたら、そこで終わって、次のシートへという形です。

シートにあるファイルって何でしょう？ファイル名が書いてあるのかな？
３行下とは？

これらを読んでも処理内容がまったく掴めません。
また、Sub Spec() のような書き方は通常しないと思います。

「該当シートが見つからない」とはグローバル変数の「s_A」がシート名を指している事を意味しているのでしょうか？
s_A=100まであるのは、100シートくらいまで処理を書けばOKだからで、100シート無い場合に上手く動かないって意味でしょうか？
ブック内の全シートを処理したい場合は、#2さんの例のように for each でWorksheetオブジェクトをループさせるか、 Worksheet.Count までループさせるかで処理をします。

例は、複数のシートがあるブックで各シートのA1～A列の最後の行までの内容を新規に追加したシートに転記します。

Sub Test1()
Dim ws As Worksheet, i As Integer, myRow As Long, cnt As Long
'1番左にシートを追加
Set ws = Worksheets.Add(before:=Worksheets(1))
cnt = 1
'左から2番目のシートから、一番右のシートまで処理
For i = 2 To Worksheets.Count
　'A1からA列の一番最後のセルまでループ
　For myRow = 1 To Worksheets(i).Range("A65536").End(xlUp).Row
　　'追加したシートに転記
　　ws.Range("A" & cnt) = Worksheets(i).Range("A" & myRow)
　　cnt = cnt + 1
　Next myRow
Next i
End Sub

> s_Aについては、spec3以降でも使っていますので、このようにグローバルで宣言しています。

全容が不明ですがグローバル宣言の必要はやはり無いと思います。
もう少しハッキリ処理内容が掴めれば、もっと的確なアドバイスが得られると思います。

お礼

ありがとうございます。
　今回教えていただいた件を少し試して、それでうまくいかなかったら、もう一度同じタイトルで今度はスクリプトを全て掲載して質問したいと思います。
申しわけありありませんが、その際に、またよろしくお願いします。

補足

新たに質問しようと思ったら、スクリプトが文字数を超えているということですので、ここに書きます。
　よろしくお願いします。

'Listにあるdocファイルを一括して、pdfファイルに変換・更新し、指定のフォルダに格納

Dim b_A As String
Dim s_A As String
Dim Mydoc As String
Dim Mydoc2 As String
Dim myFSO As Object

' スリープ関数(API)の宣言
Declare Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Sub Spec()

b_A = "CA"
Call Spec2

b_A = "CR"
Call Spec2

b_A = "CT"
Call Spec2

b_A = "CV"
Call Spec2
'b_Aは、workbookの名前で、これが、50くらいあります。

MsgBox "PDF処理が終わりました。"

End Sub

Sub Spec2()

s_A = "00"
Call Spec3
Call Spec4
s_A = "01"
Call Spec3
Call Spec4
s_A = "02"
Call Spec3
Call Spec4
s_A = "03"
Call Spec3
Call Spec4
's_Aがworksheetの名前でこれが、100くらいまであります。
ActiveWorkbook.Close

End Sub

Sub Spec3()
'Workbooks.Close

'Application.ScreenUpdating = False 'マクロ実行中画面の変更を凍結

On Error Resume Next ' エラーが出たら次へ

Workbooks.Open Filename:="I:\GIJUTSU\SPEC\LIST\" & (b_A) & "_list.xls" '指定のワークブックを開く
Sheets(s_A).Select '指定のシートを開く
Range("b3").Select 'セルB3に移動

Do Until Selection.Value = "" 'セルが空になるまで

Call Wait

Mydoc = "I:\GIJUTSU\SPEC\" & (b_A) & "\" & (s_A) & "\" & (ActiveCell) & ".doc" 'PDF化したいファイル
Mydoc2 = "I:\GIJUTSU\PDF\spec\" & (b_A) & "\" & (s_A) & "\" & (ActiveCell) & ".pdf"

If FileDateTime(Mydoc) > FileDateTime(Mydoc2) Then
Set WordObj = CreateObject("Word.Application")
WordObj.Documents.Open (Mydoc)
WordObj.Visible = False
currentPrinter = WordObj.Application.ActivePrinter
WordObj.ActivePrinter = "Acrobat Distiller on LPT1:" ' 環境に応じて書き換え
WordObj.Options.UpdateFieldsAtPrint = True '上書きの確認?
WordObj.Options.PrintBackground = False 'バックグラウンドでの印刷指定
WordObj.Options.PrintReverse = False '印刷順指定
WordObj.ActiveDocument.PrintOut
WordObj.ActiveDocument.Close SaveChanges:=False
WordObj.Application.ActivePrinter = currentPrinter '?
WordObj.Quit '?
Set WordObj = Nothing 'オブジェクトを開放

ElseIf Dir(Mydoc2) = "" Then
Set WordObj = CreateObject("Word.Application")
WordObj.Documents.Open (Mydoc)
WordObj.Visible = False
currentPrinter = WordObj.Application.ActivePrinter
WordObj.ActivePrinter = "Acrobat Distiller on LPT1:" ' 環境に応じて書き換え
WordObj.Options.UpdateFieldsAtPrint = True '?
WordObj.Options.PrintBackground = False 'バックグラウンドでの印刷指定
WordObj.Options.PrintReverse = False '印刷順指定
WordObj.ActiveDocument.PrintOut
WordObj.ActiveDocument.Close SaveChanges:=False
WordObj.Application.ActivePrinter = currentPrinter '?
WordObj.Quit '?
Set WordObj = Nothing 'オブジェクトを開放

Else

End If
Loop

End Sub

Sub Spec4()

On Error Resume Next ' エラーが出たら次へ
Set myFSO = CreateObject("Scripting.FileSystemObject")
myFSO.CopyFile "C:\Documents and Settings\Administrator\デスクトップ\*.pdf", "I:\GIJUTSU\PDF\SPEC\" & (b_A) & "\" & (s_A) & "\", True
myFSO.DeleteFile "C:\Documents and Settings\Administrator\デスクトップ\*.pdf"
Set myFSO = Nothing

End Sub

' *秒待ち関数
Public Sub Wait()
sleep 6000
Selection.Offset(1, 0).Select '?
End Sub

回答No.4

ki-aaa

>9000は該当の行数を指定するということですよね

違います。

>最後の行に9000:を入れて、そこにジャンプさせるということですか？つまりは、
>9000:に限らず文字列を指定すれば良いということなのでしょうか？

その通りです。

9000:は行ラベルです。
英数字であれば大丈夫です。　コロン":"で終わります。
また、行頭から(9000:の左にスペースがあったらだめだということ)書きます。

お礼

ありがとうございました。
　これから、出掛けるので、帰ってから試します。

回答No.3

ki-aaa

エラーがでたら、Sub Spec3()の処理をスキップしたいのでしょか。

でしたら、こうしたら如何でしょう。

Sub Spec3()
On Error GoTo 9000
　・
　・
9000:
End Sub

お礼

ありがとうございます。
このGoTo 9000の9000は該当の行数を指定するということですよね。
いや、最後の行に9000:を入れて、そこにジャンプさせるということですか？つまりは、9000:に限らず文字列を指定すれば良いということなのでしょうか？

回答No.2

imogasi

何をやろうとしているのか、書いてないので判らないが
想像で、あるブック内の全シートを対象に何かをやるなら下記をヒントにすれば簡単ですよ。
存在するものを処理するので見つからないがあり得ない。
Sub test01()
Dim sh As Worksheet
For Each sh In Worksheets
MsgBox sh.Name 'ここに「sh.ＸＸＸ」を使った処理ルーチンが来る
Next
End Sub
ｓｐｅｃ３（）でＤｏＵｎｔｉｌで繰り回していますが変化するのは何なのでしょう。シートでしょうか。
Selection.Value = ""
のＳｅｌｅｃｔｉｏｎとの関係が良く判りません。
Dim s_A As String の変数ｓ＿Ａはグローバルになっていますが、このケースではローカルでも良いと思います。

お礼

ありがとうございます。
あまりに省いてしまってわかりにくかったようですね。
教えていただいた構文を参考にしたいのですが、さっぱりわかりません。あとで、色々と調べてみます。
　なにがやりたいのかは、No1の方のお礼に書いてありますので、良かったら見てみてください。

回答No.1

papayuka

変数 s_A が何に使われているか不明ですし、全体がどんな処理かもわかりません。

s_A を1ずつ足して、Spec3とSpec4を呼んでいるだけなら、
s_A はプライベートで宣言してループすれば良いだけに思いますが、、、

お礼

早速の回答ありがとうございます。
マクロが長いので全て書くのも読むのも大変だと思って書かなかったのですが、やりたいことは、Excelのシートにあるファイルを順にPDFに変換していきます。で、空白セルが出てきたら、そこで終わって、次のシートへという形です。
　s_Aについては、spec3以降でも使っていますので、このようにグローバルで宣言しています。
全体像が見えないので、質問の意味がわからなかったようですね。申し訳ありません。