Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap




' TOCで選択されたレイヤがあるかどうかを確認します。
If pMxDoc.SelectedItem Is Nothing Then
  MsgBox "TOCでいずれかのアイテムを選択する必要があります"
  Exit Sub
End If
If Not TypeOf pMxDoc.SelectedItem Is IFeatureLayer Then
  MsgBox "TOCでレイヤを選択してください"
  Exit Sub
End If
Dim pDispTab As IDisplayTable
Set pDispTab = pMxDoc.SelectedItem
' 空の選択セットを作成します。一方では全てのフィーチャを格納したFeatureCursorを取得します。
Dim pFCursor As IFeatureCursor
Dim pSelSet As ISelectionSet
Dim pTable As ITable
Dim pFeatCls As IFeatureClass
Dim pFeat As IFeature
Set pTable = pDispTab.DisplayTable
Set pSelSet = pTable.Select(Nothing, esriSelectionTypeHybrid, _

　　esriSelectionOptionEmpty, Nothing)
Set pFeatCls = pTable
Set pFCursor = pFeatCls.Search(Nothing, False)

' ジオメトリがNullでないフィーチャを選択セットに追加します。
Set pFeat = pFCursor.NextFeature
Do While (Not pFeat Is Nothing)
  If Not pFeat.Shape Is Nothing Then
    If Not pFeat.Shape.IsEmpty Then
      If pFeat.HasOID Then
        pSelSet.Add pFeat.OID
      End If
    End If
  End If
  Set pFeat = pFCursor.NextFeature
Loop
' レイヤに選択セットを適用します。
Dim pActiveView As IActiveView
Dim pFeatSel As IFeatureSelection
Set pActiveView = pMap
Set pFeatSel = pDispTab
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
Set pFeatSel.SelectionSet = pSelSet
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing