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

回答No.5

MRT1452 · ベストアンサー

"具体的なコード"といわれましても、()書きの部分が適当な命令文に置き換わるだけですが（汗

エラー処理の部分だけで言えば、記述自体は間違っていませんよ。
まぁ、できればON ERRORの宣言は一番最初にした方が良いかと。

ただ、前述でも注意書きしたと思いますが、エラー用に設けたラベルの前にExit Subの記述が見受けられません。
この措置をしないと、正常に処理した場合でもエラー用の処理を行ってしまい、
正常であっても「写真が読み込めませんでした」というメッセージが表示されることになります。

（前略）
End With

Exit Sub　　←これが無い（他のExit～同様、ここでSubを抜ける(→本関数を終了する)という意味）
errMSG:
MsgBox "写真が読み込めませんでした"

End Sub

他の方も書かれていますが。
まずはデバッグや、ブレイクポイントを付けて、プログラムを途中で止め、
それぞれのオブジェクトや変数に異常がないか(本来貴方が予想している値になっているか)等を
確認した方が良いかと。

お礼

MRT1452様

度重なる浅はかな質問にも、ご親切に回答いただき誠にありがとうございます。

NO4の回答者様にもご指摘頂いたとおり、今後は質問する前に自分で確認をしっかりするように努めます。

色々と参考になりました。ありがとうございました。

回答No.4

mitarashi

なんとか課題をクリアしようという熱意は評価いたしますが、回答者に長いリストを読ませるのではなく、課題を単純化して、問題箇所を絞るスキルを身につけていただきたいと希望します。当方、全文を読んではおりません。

If pict.TopLeftCell.Address = targetRange.Address

でエラーが出るとの事ですが、右辺はActivesheetのセル決め打ちなので、ワークシートのチェンジイベントで動かしている以上、問題にはならないと思います。とすると、問題が起きる時の左辺が何かというのが気になります。
コードを斜め読みした限りでは、写真以外にshapeがいくつかある様ですね。
エラー箇所の直前に、
debug.print pict.name,pict.type
とかして、どんなshapeが問題を起こすのか確認なさってください。

Addpictureした写真のみを対象にするには、
With ActiveSheet
For Each pict In .Shapes
If pict.Type = msoLinkedPicture Then
If pict.TopLeftCell.Address = targetRange.Address Then
pict.Delete
End If
Exit For
End If
Next pict

などとすれば良いと思います。
写真のshape.typeは、msopicture=13かと思いましたが、当方で確認したところではmsoLinkedPicture=11でした。
なお、当方xl2000です。

お礼

mitarashi様

回答誠にありがとうございます。

そして、全くもって面目ございません。まさしくご指摘の通りであり、自身反省・自重し、無駄に長い投稿を控えるように致します。

作成にあたり、色んなプレッシャーがあり、また誰にも聞くことができず、藁にもすがる思いでなりふり構わずだったところがあると自覚いたしております。

完全には理解できませんでしたが、参考になりました。アドバイスいただいたとおり確認を致します。

ありがとうございました。

回答No.3

MRT1452

なんか自分は見当違いな所を見ていたようで。
それはともかくとして。

エラーが発生した場合にプログラム止めないようにする(と言うよりはエラー時の対応処理)には、
例外処理を行うようにします。

端的に、エラーが起きたときに、システムに替わってプログラムがこのように対応しますよということを、
プログラムで明示する方法。

多くの場合は、ON ERRORでエラーを拾うという方法。

自分の場合はON ERROR GOTOを用いて、

Sub AAA()
ON ERROR GOTO EXP ・・・EXPはラベル名(任意名)

（正常処理）

Exit Sub
EXP:　・・・ラベル名：　でラベルとして認識されます。

(例外エラー発生時の処理)

End Sub

これで、例外エラーをプログラムとして拾うので、一部の重大な例外を除き、エラーをスルーできます。

ただし、これはプログラムとして拾うようにするだけなので、考えて作らないと、
エラーとしてシステムを止めないといけないのに、そのまま流れてしまって重大なデータ破損が起きてしまうという事も考えられます。

通常は
例外エラーを拾ったら、
msgbox(Err.Description)
等で、システムが吐き出す例外エラーの出力を代行するという形を取ると良いかと。

また例外エラー発生時に移動先として指定するラベルの前に、
Exit Subをつけて、正常処理が例外処理に入ってこない様にする工夫も必要です。

ON ERROR GOTOはあくまでエラーがおきたら、指定したラベルに飛ぶというだけの意味で、
プログラム自体は、指定ラベルを例外専用のラベルとは認識しません。

ただ、エラー発生時にソースに飛んだりしないので、ON ERRORは利用価値は高いと思います。
逆にデバッグ時にはネックになったりすることもありますが。
（作り方によっては、エラーが発生しても、正常終了したかのように見せ掛ける事も可能なので）

お礼

回答ありがとうございます。

誠に申し上げにくいのですが、出来れば、具体的なコードでアドバイスを頂けるとありがたいです。
甘えてばかりではいけないので、自分なりに調べてコードをon errorのコードを盛り込んでみたのですが、
下記コードだと、逆にメッセージばかりが出てしまいます。

Private Sub myLoadPicture(folderName As String, fname As String, targetRange As Range)
Dim pict As Shape, picPath As String
On Error GoTo errMSG
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

errMSG:
MsgBox "写真が読み込めませんでした"

End Sub

回答No.2

mks1902

If pict.TopLeftCell.Address = targetRange.Address Then
pict.Delete

pict.Deleteのところが改行さてます。
If pict.TopLeftCell.Address = targetRange.Address Then pict.Delete

お礼

回答ありがとうございます。

>pict.Deleteのところが改行さてます。
>If pict.TopLeftCell.Address = targetRange.Address Then pict.Delete

ご指摘頂いた内容で修正させて頂きましたところ、今度は「コンパイルエラー　End ifに対応するIfブロックがありません。」と表示されるようになってしまいました。

またご確認頂ければと思います。

回答No.1

MRT1452

該当の命令等はわかりませんが、
まずは、左辺、右辺とも、ちゃんと値が取得できているか確認。
（どちらが問題となっているのかの特定）

見る限りセル位置のプロパティ等みたいなので、そこの座標情報に０とか有りえ無い位置情報が入ると、
１００４エラーになったりするみたいですが。

自分がShapeに関して全然わからないというのもありますが、
他、気になるのは、targetRangeがWorksheet下のRangeだとして、そのRangeと
Shape下のRangeを返すTopLeftCellが同じ扱いが出来るのかとか。

1004エラーはたしか、オブジェクト上での何らかの不整合でも起きるエラーなので。
どこでコケているか等の切り分けをしないと原因を探すのは結構難しいかと。

お礼

ありがとうございます。正直今の私の実力では、原因究明と修正は出来そうもありません。
そこでエラーが起こった場合に、リロード（再読み込み）するか、exit sub する方法（コード）をアドバイスいただけると有り難いです。
せっかく回答を頂けたのに、ご無理いって申し訳ございません。