| 
    
     |  | ▼ピッポ さん: 
 >コードもなるべく、無理がない限り従来のコードをベース
 >使用して頂けると今後の参考になります。
 
 アップされたコードは、以前にももう下げたとおり、インデントが正しくついていません。
 ですので、各ロジックの固まりが、どのように遷移するのか、どの単位でループするのか
 はなはだ、わかりにくくなっています。
 
 以下は、アップされたコードの中の細かなコードを削除し、大きな流れを把握する部分のみを残して
 それにインデントをつけたものです。
 
 1組の If/End If や For/Next が同じ位置(桁)から始まっています。
 まずは、これを印刷し、セロハンテープで貼り合わせて1枚の紙にして、ひとかたまりのブロックを
 そのレベル別に(始まっている桁別に)蛍光ペンあたりで色別に塗り分けた上で
 じっくりと、【流れ】をおいかけてください。
 
 とくに後半のシートが複数ある場合の流れで、随分奇妙なループになっていることが
 わかるはずです。
 
 まず、このあたりから整理されたらよろしいかと思います。
 
 For Each c In sh1.Range("F11", sh1.Range("F" & sh1.Rows.Count).End(xlUp))
 
 捺印数 = sh1.Range("AF" & i).Value
 
 'F列にハイパーリンクなければスキップ
 If c.Hyperlinks.Count > 0 Then
 
 'リンク先フォルダが存在するものだけ
 If myFso.FolderExists(oFold) Then
 
 For Each myFile In myFso.GetFolder(oFold).Files
 
 If e = "xls" Then
 
 シート数 = sh1.Range("AG" & i).Value
 
 'ワークシート数が1つの場合
 If シート数 = 1 Then
 
 'ブックオープンし、リンク先フォルダのxlsファイルに図形があるか判定
 Set fWb = Workbooks.Open(oFold & "\" & fName)
 
 For Each fSh In fWb.Worksheets
 i2 = 0
 For Each MyOb In fSh.Shapes '
 
 If MyOb.Type = msoPicture Then  '
 If Not Intersect(MyOb.TopLeftCell, fSh.Range("A1:BV9")) Is Nothing Then
 '左上角指定で選択されたシートのみを対象にする
 'このifが無いとシート全体が対象になる
 i2 = i2 + 1
 End If
 End If
 
 Next
 
 fWb.Close False
 If i2 <> 捺印数 Then Exit For
 
 Next
 
 If i2 <> 捺印数 Then Exit For
 
 End If
 
 
 If シート数 >= 2 Then
 
 'ブックオープンし、リンク先フォルダのxlsファイルに図形があるか判定
 Set fWb = Workbooks.Open(oFold & "\" & fName)
 
 For Each fSh In fWb.Worksheets
 
 y = fWb.Sheets.Count
 
 For n = 1 To y        'シート数分だけループ
 
 i2 = 0
 
 For Each MyOb In fSh.Shapes '
 
 If MyOb.Type = msoPicture Then  '
 
 
 If Not Intersect(MyOb.TopLeftCell, fSh.Range("A1:BV9")) Is Nothing Then
 '左上角指定で選択されたシートのみを対象にする
 'このifが無いとシート全体が対象になる
 i2 = i2 + 1
 
 End If
 
 End If
 
 Next
 
 If i2 <> 捺印数 Then Exit For
 
 Next
 
 fWb.Close False
 If i2 = 捺印数 Then Exit For
 
 Next
 
 End If
 
 
 End If
 Next
 
 '問題有り無しをJ列に記入
 
 End If
 
 End If
 
 Next
 
 |  |