EXCEL VBA エラーの意味が分からず
いつも、お世話になっております。
下記コードで、レコード１と２を前へと次へを繰り返し何度か操作すると、エラーになってしまいます。なぜエラーになって、どう修正すれば回避できるのかが分かりません。
どうかご教授いただけないでしょうか。よろしくお願いいたします。
エラーの状況
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
お礼
kmetuさん、素早いかつ確実なご回答どうもありがとうございます。 おかげさまでうまく実行できました。 ネットと本を参考に初めてVBAを使用して今回作成しているのでいざという時に応用が利かなくて困ってましたが大変助かりました。