Как определить на каком именно листе вставлен блок

 
Public Function BlockFrameFound(minExt As Variant, maxExt As Variant, blkname As String) As Boolean

    Dim blocks() As AcadBlockReference
    Dim blkref As AcadBlockReference
    Dim objSpace As AcadBlock
    Dim blkColl As New Collection
    Dim i
    Dim extObjs() As AcadEntity
    Dim fType(0 To 2) As Integer
    Dim fData(0 To 2) As Variant
    Dim dxfCode, dxfValue
        fType(0) = 0: fData(0) = "INSERT"
        fType(1) = 2: fData(1) = "`*U*," & blkname
        fType(2) = 100: fData(2) = "{ACAD_XDICTIONARY"
        dxfCode = fType: dxfValue = fData
    Dim oSset As AcadSelectionSet
    Dim ExtSset As AcadSelectionSet
    Dim oEnt As AcadEntity
    Dim oBlkRef As AcadBlockReference
    Dim oBlock As AcadBlock
    Dim oLayout As AcadLayout
    Dim bName As String
    Dim obj As AcadBlock
    Dim item As AcadEntity
    Dim Namelayot As String
        BlockFrameFound = False
        With ThisDrawing.SelectionSets
               While .Count > 0
                    .item(0).Delete
               Wend
          Set oSset = .Add("$BlockSset$")
          Set ExtSset = .Add("$BlockSsetExtracted$")
        End With
        
        oSset.Select acSelectionSetAll, , , dxfCode, dxfValue
        
        If oSset.Count = 0 Then
             BlockFrameFound = False
            Exit Function
           Else
        End If
   
        For Each oEnt In oSset
            Set oBlkRef = oEnt
            Set obj = ThisDrawing.ObjectIdToObject(oEnt.OwnerID)
            If Not obj Is Nothing And obj.IsLayout Then
                Set oLayout = obj.layout
            End If
         If oBlkRef.EffectiveName = blkname Then
            ReDim Preserve extObjs(i) As AcadEntity
            Set extObjs(i) = oBlkRef
            i = i + 1
         End If
        Next oEnt

        If Not IsNull(extObjs) Then
           ExtSset.AddItems (extObjs)
        End If

        If ExtSset.Count = 0 Then
            BlockFrameFound = False
            Exit Function
        End If
        Set objSpace = GetSpase
        If objSpace Is ThisDrawing.ModelSpace Then
          Namelayot = "Model"
            Else
          Namelayot = ThisDrawing.ActiveLayout.Name
        End If

    minExt = Empty
    maxExt = Empty
    For Each item In ExtSset
        Set obj = ThisDrawing.ObjectIdToObject(item.OwnerID)
        Set oLayout = obj.layout
        If oLayout.Name = Namelayot Then
             item.GetBoundingBox minExt, maxExt
               BlockFrameFound = True
              Exit For
        Else
          BlockFrameFound = False
          minExt = Empty
          maxExt = Empty
       End If
    Next item

Err_Control:
    If Err.Number <> 0 Then
    MsgBox Err.Description
    End If

End Function