vbaエラーの原因とは?

このQ&Aのポイント
  • vbaエラーの原因を解説します。実行時エラー1004または、マクロ実行時にエラー400と表示される場合、エクセルファイルの読み込みや印刷の関連で問題が発生している可能性があります。
  • 特に、エクセルファイルの読み込み時に発生するエラーコード1004は、ファイル名やパスワードの設定に誤りがある場合によく起こります。また、マクロ実行時のエラーコード400は、エクセルのシートやセルの操作に問題がある場合に発生することがあります。
  • 質問の内容から推測すると、シート2に氏名と読み取りパスワードが記載されており、それを使ってエクセルファイルを読み込み、印刷する処理を行っているようです。エラーが発生する原因は、ファイル名やパスワードの設定、シートやセルの操作に何らかの誤りがある可能性があります。該当する箇所を確認し、修正してみてください。
回答を見る
  • ベストアンサー

vbaエラーの原因

先ほどまで動いていたのですが、保存後にエラーとなりました。 実行時エラー1004または、マクロ実行時にエラー400と表示されます。 どこが変わったのか、自分でもわからず、苦戦しています。 シート2(左から2番目)に氏名と読み取りパスワードが記載されています。 それをつかって、氏名をファイル名としたエクセルファイルを読み込ませ、 印刷をさせるまでの一連の動作となります。 --- Sub printcode() Dim wbk As Workbook Dim targetRange As Range Dim i As Long Set targetRange = ThisWorkbook.Worksheets(2).Range("A1").CurrentRegion For i = 2 To targetRange.Rows.Count Set wbk = Workbooks.Open(targetRange.Cells(i, 1).Value & ".xls", Password:=targetRange.Cells(i, 2).Value) Sheets("Sheet1").PrintPreview 'PrintOut wbk.Close Set wbk = Nothing Next i End Sub --- 印刷実行前に動作確認として、プレビューコマンドを使用しています。 どの辺にエラーがあるのか、一つずつ確認しているのですが、おそらく前半と思われます。 ご指摘いただけますでしょうか。よろしくお願いいたします。

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

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

まずファイル名、パスワードが正しく読まれているのか確認しましょう ファイル名は、パスの指定までされているのでしょうか?   Set targetRange = ThisWorkbook.Worksheets(2).Range("A1").CurrentRegion   For i = 2 To targetRange.Rows.Count     MsgBox "ファィル名:" & targetRange.Cells(i, 1).Value & vbCrLf & _       "パスワード:" & targetRange.Cells(i, 2).Value   Next i

makun100
質問者

お礼

回答ありがとうございました。 パスの指定と言われて気づきました。 ファイルオープン時のコードで、ThisWorkbook.Path の指定を忘れていたようです。

その他の回答 (1)

  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.2

シートの2枚目が無い、開こうとしているファイルが無い、パスワードが変わった等、いろいろと考えられます。 F8で1ステップづつ実行して、どこでエラーが起こっているのかを確認してください。

makun100
質問者

お礼

回答ありがとうございました。 ファイルのパス指定を忘れていたようです。

関連するQ&A

  • VBA リストボックス(複数条件)で検索⇒転記方法

    VBA初心者です。 入門書を読み、コンボボックスを用いる(一つの条件検索)で請求書ツール作成までできたのですが、画像のようにユーザーフォームに複数選択リストを設けると現在のコードですと、エラーになってしまいます。 つきましては、リストボックスで条件を複数選択可能にして、該当データを転記するといったことを行いたいです。大変恐縮ですが、コードをご教示お願い致します。 ↓参考に、現状のコードを下記致します。 (ユーザーフォームのコード) Private Sub btnExit_Click() Unload Me End Sub Private Sub UserForm_Initialize() Dim ListRange As Range Dim temp As Range Dim vYear As Long Dim i As Long With Worksheets("取引先一覧").Range("A1").CurrentRegion Set ListRange = .Resize(.Rows.Count - 1).Offset(1) End With For Each temp In ListRange cmbcompany.AddItem temp.Value Next vYear = Year(Date) cmbYear.AddItem vYear - 1 cmbYear.AddItem vYear cmbYear.AddItem vYear + 1 cmbYear.Value = vYear For i = 1 To 12 cmbMonth.AddItem i Next End Sub Private Sub btnMakeBill_Click() MakeBill cmbcompany.Text, cmbYear.Text, cmbMonth.Text End Sub (標準モジュールのコード) Option Explicit Sub Main() frmMakeBill.Show End Sub Sub MakeBill(ByVal vCompany As String, ByVal vYear As Long, ByVal vMonth As Long) Dim TargetSheet As Worksheet Dim vDate As Date Dim DataRange As Range Dim TargetRange As Range Dim BillBook As Workbook Dim i As Long, vRow As Long Dim vInfo(1 To 2) As String On Error Resume Next Worksheets("請求書Template").Copy After:=Worksheets(Worksheets.Count) If Err.Number <> 0 Then MsgBox "「請求書Template」ワークシートが見つかりません。確認下ください" Exit Sub End If On Error GoTo 0 On Error GoTo ErrHdl Set TargetSheet = Worksheets(Worksheets.Count) Set TargetRange = TargetSheet.Range("A18") i = 1 vRow = 1 With Worksheets("受注データ").Range("A9") Do Until .Cells(i, 1).Value = "" vDate = .Cells(i, 1).Value If .Cells(i, 2).Value = vCompany _ And Year(vDate) = vYear And Month(vDate) = vMonth Then TargetRange.Cells(vRow, 1).Value = .Cells(i, 1).Value '「日付」列 TargetRange.Cells(vRow, 2).Value = .Cells(i, 3).Value '「商品コード」列 TargetRange.Cells(vRow, 3).Value = .Cells(i, 4).Value '「商品名」列 TargetRange.Cells(vRow, 4).Value = .Cells(i, 5).Value '「数量」列 TargetRange.Cells(vRow, 5).Value = .Cells(i, 6).Value '「単価」列 TargetRange.Cells(vRow, 6).Value = .Cells(i, 7).Value '「金額」列 vRow = vRow + 1 End If i = i + 1 Loop TargetSheet.Range("F28").Formula = "=SUM(F18:F27)" '「小計」 TargetSheet.Range("F29").Formula = "=F28 * 0.08" '「消費税額」 TargetSheet.Range("F30").Formula = "=F28 + F29" '「合計金額」 TargetSheet.Range("B6").Formula = "F30" '請求額 vInfo(1) = Date vInfo(2) = vCompany TargetSheet.Range("F2").Value = vInfo(1) '「請求日」 TargetSheet.Range("A6").Value = vInfo(2) '「請求先」 End With Set BillBook = Workbooks.Add TargetSheet.Cells.Copy BillBook.Worksheets(1).Range("A1") Application.DisplayAlerts = False TargetSheet.Delete Application.DisplayAlerts = True Exit Sub ErrHdl: MsgBox "エラーが発生しました。処理を終了します" End Sub

  • EXCEL VBA エラーの意味が分からず

    いつも、お世話になっております。 下記コードで、レコード1と2を前へと次へを繰り返し何度か操作すると、エラーになってしまいます。なぜエラーになって、どう修正すれば回避できるのかが分かりません。 どうかご教授いただけないでしょうか。よろしくお願いいたします。 エラーの状況 inputシートで、maeとtsugiの動作を何度か行うと、「If pict.TopLeftCell.Address = targetRange.Address Then」の部分が黄色く塗りつぶされ、「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。」と表示されてしまします。たぶん写真の削除の時にエラーになっているのだと思いますが、 '■標準モジュールのコード。dataシートのレコードを移動し、inputシートのBC1セルに表示する。 Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("A1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() On Error GoTo errhandle If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If Exit Sub errhandle: Call Saisyo End Sub Sub Tsugi() On Error GoTo errhandle If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If Exit Sub errhandle: Call Saigo End Sub Sub Tenki() Worksheets("input").Range("BC1").Value = trg.Offset(0, 0) End Sub '■sheet 1のモジュール。inputシートBC1セルの値を見て、dataシートへ値を読みにいき、inputシートへ表示する。 Private Sub hyouji() Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった? MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If kensaku = fRange.row '検索された顧客DCの行位置を求める Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value '整理No Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value '固有ID Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value '工場名 Range("P4").Value = Sheets("data").Cells(kensaku, 4).Value '柱No Range("W4").Value = Sheets("data").Cells(kensaku, 5).Value '盤No Range("I5").Value = Sheets("data").Cells(kensaku, 6).Value '変台系統1 Range("S5").Value = Sheets("data").Cells(kensaku, 7).Value '変台系統2 Range("I6").Value = Sheets("data").Cells(kensaku, 8).Value '分電盤設置時期 Range("B8").Value = Sheets("data").Cells(kensaku, 9).Value '主な供給先 Range("B14").Value = Sheets("data").Cells(kensaku, 10).Value '特記 Range("AD4").Value = Sheets("data").Cells(kensaku, 11).Value '盤位置の目安 Range("AT8").Value = Sheets("data").Cells(kensaku, 12).Value '幹線線相 Range("R36").Value = Sheets("data").Cells(kensaku, 13).Value '盤写真ファイル名 Range("AT36").Value = Sheets("data").Cells(kensaku, 14).Value '単結図ファイル名 End Sub '■sheet 1のモジュール。"$R$36"と"$AT$36"の写真ファイル名を見て、"C37"と"AE37"セルに表示させる。 Private Sub Worksheet_Change(ByVal Target As Range) Dim fRange As Range Dim touroku As Long Select Case Target.Address Case "$BC$1" Call hyouji Case "$R$36" myLoadPicture "board_Image", Target.Text, Range("C37") Case "$AT$36" myLoadPicture "map_Image", Target.Text, Range("AE37") Case "$AT$8" Call red_circle Case Else Exit Sub End Select End Sub Private Sub myLoadPicture(folderName As String, fname As String, targetRange As Range) Dim pict As Shape, picPath As String picPath = ThisWorkbook.Path & "\" & folderName & "\" & fname If fname = "" Then picPath = ThisWorkbook.Path & "\" & folderName & "\" & "NoImage.jpg" End If With ActiveSheet For Each pict In .Shapes If pict.TopLeftCell.Address = targetRange.Address Then pict.Delete Exit For End If Next pict Set pict = .Shapes.AddPicture(picPath, msoTrue, msoFalse, _ targetRange.Left, targetRange.Top, 300, 360) End With End Sub

  • EXCEL2010エラーVBA

    下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391 がエラーメッセージです。 何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub

  • VBA 初心者

    sheet1から、sheet2データを検索して抽出する練習をしているのですがerror"1104"が表示されます、なぜなのか分からないので投稿しました、よろしくお願いします。 sub test() dim sh1 as worksheets dim sh2 as worksheets dim  i  as  integer set sh1 = thisworkbook.worksheets("sheet1!") set sh2 = thisworkbook.worksheets("sheet2!") b = userform1.textbox1 for i = 1 to 10 sh1 .cells(i,2) = b b = b+1 x = sh1.cells(1,2) sh1.cells(i,3).value = worksheetfunction.vlookup(x,sh2.range("a1:d500"),2,false) next i end sub

  • エクセル2019 VBAについて

    エクセル2019でVBAを使いコピーペーストの勉強中です、次の箇所(Dim i As integr)で、ユーザー定義型は定義されていませんと指摘されて止まってしまします、Sheet("データ")には3行のデータは入っています、VBA初心者のため、この後が、なかなか前に進めません、どうかよろしくおねがいします。 ********************************** Sub 練習() Dim s1 As Worksheet: Set s1 = Worksheets("請求書") Dim s2 As Worksheet: Set s2 = Worksheets("データ") Dim r1 As Integer: r1 = 18 Dim r2 As Integer: r2 = 2 { Dim i As integr } For i = 0 To 2 s1.Range(s1.Cells(r1 + i, 1), s1.Cells(r1 + i, 3)).Value = s2.Range(s2.Cells(r2 + i, 2), s2.Cells(r2 + i, 4)).Value s1.Cells(r1 + i, 4).Value = s1.sells(r1 + i, 2).Value * s1.Cells(r1 + i, 3).Value Next End Sub ***************************************

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート(作業中シート)に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ~??わからな~い??おしえてくださーい!! Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

  • Excel VBA 実行時エラー'1004':

     どちらの処理がより高速であるのかを調べるため、以下の2つのVBAを試作致しました。 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub  処が、これらのVBAを実際に動作させ様としますと、どちらの場合においても「Microsoft Visual Basic」ダイアログボックスが開いて 「実行時エラー'1004': 'Range'メソッドは失敗しました:'_Global'オブジェクト」 と表示されてしまいます。  さりとて、 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select ActiveSheet.Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub 或いは Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range(Cells(i, 1)).Value = Rnd Next i Range("B1").Select End Sub 等としましても、今度は 「実行時エラー'1004': アプリケーション定義またはオブジェクト定義のエラーです。」 となってしまいます。  どの部分がどの様に悪いのでしょうか?  そして、どの様に修正すれば良いのでしょうか?  尚、使用しておりますExcelのバージョンはExcel2010です。

  • vbaのエラーを修正するコード(初心者です)??

    シートの c1セルに =a1+5 という式があります。 a10からa14にそれぞれ1,2,3,4,5と数字が入っています。 Sub 計算() If Cells(1, 3).Value < 10 Then Cells(1, 4).Value = 100 Else Cells(3, 1).Value End If End Sub Sub エラー() Dim i As Integer For i = 1 To 5 Cells(1, 1).Value = Cells(10 + i, 1).Value Application.Run "計算" Next i End Sub 以上のコードを書きます。 「Sub 計算」の4行目が不完全なのはあえてそうしています。 で、実行すると、当然ながらエラーが出ます。 そこで、実行時エラーを終了してa14に4.9と数字を手入力し、 再度「Sub エラー」を実行すると無事に終了です。 このエラー後の「終了→入力→実行」を「Sub エラー」の中に 書きたいんですが… 数式に関しては、例示なので触れないでください。 あくまで手順を教えていただきたいのです。 何卒ご教授ください。

  • VBAで実行時エラー1004が出ます

    VBAで実行時エラー1004が出ます。 「Rangeメソッドは失敗しました。Worksheetオブジェクト」です。 あらゆる可能性を調べたのですが、分かりません。誰か教えて頂けますでしょうか? 下記コードの「Cells(m, 7) =・・・」の部分がエラーになりました。 Sub ボタン1_Click() Dim 現シート As Worksheet ~ 現シート.Activate Cells(m, 7) = WorksheetFunction.VLookup(現シート.Range(現シート.Cells(m, 4)).Select, 現シート.Range(現シート.Cells(4, 104), 現シート.Cells(15, 107)).Select, 4, False) ~ End Sub 何卒宜しくお願いいたします。

  • VBA 別シートからコピー貼付け(複数列)

    別シートからコピー貼付け(複数列)をしたいのですが,同一シートからのコピー貼付けはネットから以下のマクロでできました。 しかし,別シートsheet1からsheet2ヘコピーで修正しましたが,「アプリケーション定義またはオブジェクト定義のエラーです。」となります。どなたかご教授よろしくお願いします。 修正したマクロ Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Sheets("sheet2").Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Sheets("sheet1").Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub 参考としたマクロ http://www.excel.studio-kazu.jp/kw/20041208152106.html Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub

専門家に質問してみよう