Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10012 / 76734 ←次へ | 前へ→

【72276】Re:捺印数の照合
発言  ピッポ  - 12/7/7(土) 9:42 -

引用なし
パスワード
   お世話になります。

質問1:
シートが1つの場合は問題なく照合できたのですが
複数シートがある際、捺印数の照合した結果、”問題なし”としか
表示されないのですがどのうように訂正すればよろしいでしょうか?


質問2:

下記のコードの構造を教えて頂きたいのですが、図形(msoPicture)
があればi2に1が代入されるというのは理解できるのですが、なぜ
i2 <> 捺印数なのか理解できませんでした。
恐れ入りますがご指導頂ければ幸いです。


If Not Intersect(MyOb.TopLeftCell, fSh.Range("A1:BV9")) Is Nothing Then
                                                            i2 = i2 + 1
                    End If
                  End If
                Next
              fWb.Close False
              If i2 <> 捺印数 Then Exit For


Option Explicit

Sub image_count()
 Dim myFso As Object
  Dim MyOb As Object
  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Dim c As Range
  Dim oFold As String
  Dim fName As String
  Dim i As Long
  Dim myFile As Object
  Dim i2 As Long
  Dim e As String
  Dim 捺印数 As String
  Dim シート数 As String
  Dim y As Long
  Dim fWb As Workbook
  Dim fSh As Worksheet


  Set myFso = CreateObject("Scripting.FileSystemObject")
  Set sh1 = Sheets("一覧表")
  Set sh2 = Sheets("元保管場所(データベース)")
 
 
  For Each c In sh1.Range("F11", sh1.Range("F" & sh1.Rows.Count).End(xlUp))
    i = c.Row
    捺印数 = sh1.Range("AF" & i).Value
    With sh1.Range("J" & i)
     
      .Font.ColorIndex = xlAutomatic
    End With
    fName = ""
    'F列にハイパーリンクなければスキップ
    If c.Hyperlinks.Count > 0 Then
      oFold = c.Offset(, 0).Hyperlinks(1).Address
      'リンク先フォルダが存在するものだけ
      If myFso.FolderExists(oFold) Then
        For Each myFile In myFso.GetFolder(oFold).Files
          e = LCase(myFso.getextensionname(myFile.Name))
          If e = "xls" Then
            fName = myFile.Name
            シート数 = 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        'シート数分だけループ
              Sheets(n).Select
              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
    
        With sh1.Range("J" & i)
          .Value = "問題" & IIf(i2 = 捺印数, "なし", "あり")
          .Font.ColorIndex = IIf(i2 = 捺印数, xlAutomatic, 3)
        End With

      End If
   
    End If
  Next
 
  Application.ScreenUpdating = True
 
  MsgBox cnt & " 個のファイルが捺印されています。", vbInformation

End Sub

4 hits

【72228】捺印数の照合 ピッポ 12/6/24(日) 0:07 質問
【72233】Re:捺印数の照合 UO3 12/6/24(日) 8:23 発言
【72237】Re:捺印数の照合 UO3 12/6/24(日) 9:59 発言
【72238】Re:捺印数の照合 ピッポ 12/6/24(日) 14:25 回答
【72239】Re:捺印数の照合 UO3 12/6/24(日) 14:49 発言
【72241】Re:捺印数の照合 ピッポ 12/6/25(月) 0:25 お礼
【72276】Re:捺印数の照合 ピッポ 12/7/7(土) 9:42 発言
【72279】Re:捺印数の照合 UO3 12/7/7(土) 17:34 発言
【72281】Re:捺印数の照合 ピッポ 12/7/8(日) 11:39 発言
【72282】Re:捺印数の照合 UO3 12/7/8(日) 16:18 発言
【72284】Re:捺印数の照合 ピッポ 12/7/8(日) 16:47 発言
【72286】Re:捺印数の照合 UO3 12/7/8(日) 18:44 発言
【72283】Re:捺印数の照合 UO3 12/7/8(日) 16:35 発言
【72285】Re:捺印数の照合 ピッポ 12/7/8(日) 18:15 発言
【72287】Re:捺印数の照合 UO3 12/7/8(日) 20:54 発言
【72288】Re:捺印数の照合 UO3 12/7/9(月) 10:29 発言
【72294】Re:捺印数の照合 ピッポ 12/7/9(月) 18:00 発言
【72298】Re:捺印数の照合 UO3 12/7/10(火) 12:31 発言
【72329】Re:捺印数の照合 ピッポ 12/7/12(木) 18:12 発言
【72334】Re:捺印数の照合 UO3 12/7/13(金) 9:45 発言
【72339】Re:捺印数の照合 ピッポ 12/7/14(土) 21:26 お礼
【72299】Re:捺印数の照合 UO3 12/7/10(火) 12:42 発言

10012 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free