Sub Main()

  Dim pDoc As IMxDocument
  Dim pLayer As IGeoFeatureLayer
  Dim pFS As IFeatureSelection
  Dim pSS As ISelectionSet

  Set pDoc = Application.Document

  'TOC内でレイヤが選択されていることを確認します。
  Set pLayer = pDoc.SelectedLayer
  Set pFS = pLayer 'QI
  Set pSS = pFS.SelectionSet

  DisplayOnlySelectedFeatures pLayer, pSS

  'データフレームを再描画します。
  pDoc.ActiveView.Refresh

End Sub

Public Sub DisplayOnlySelectedFeatures(pGlayer As IGeoFeatureLayer, _
pSelectionset As ISelectionSet)

  '変数宣言
  Dim pFCEntire As IFeatureCursor
  Dim pSelFC As IFeatureCursor
  Dim lEntireOID As Long
  Dim lSelOID As Long
  Dim pFeatureIDSet As IFeatureIDSet
  Dim pEntireEnumId As IEnumIDs
  Dim pSelEnumIds As IEnumIDs
  Dim pEntireSelSet As ISelectionSet

  'フィーチャクラス内の全フィーチャをFeatureCursorとSelectionSetへ格納します。
  Set pFCEntire = pGlayer.FeatureClass.Search(Nothing, False)
  pSelectionset.Search Nothing, False, pSelFC

  'SelectionSetからIDリストを取得します。
  Set pSelEnumIds = pSelectionset.IDs
  pSelEnumIds.Reset
  lSelOID = pSelEnumIds.Next
  Set pEntireSelSet = pGlayer.FeatureClass.Select(Nothing, _
  esriSelectionTypeHybrid, esriSelectionOptionNormal, Nothing)
  Set pEntireEnumId = pEntireSelSet.IDs
  pEntireEnumId.Reset
  lEntireOID = pEntireEnumId.Next
  Set pFeatureIDSet = New FeatureIDSet

  'ループ処理によって全てのOIDをFeatureIDSetオブジェクト内に追加します。
  Do Until lEntireOID = -1
    pFeatureIDSet.Add lEntireOID
    lEntireOID = pEntireEnumId.Next
  Loop

  '選択したフィーチャのOIDリストをループ処理します。
  'FeatureIDSet内にOIDが含まれている場合は、そのIDをFeatureIDSetから取り除きます。
  Do Until lSelOID = -1
    If pFeatureIDSet.Contains(lSelOID) Then
      pFeatureIDSet.Remove (lSelOID)
    End If
    lSelOID = pSelEnumIds.Next
  Loop

  '取り除いたFeatureIDSetを設定して表示するフィーチャを制限します。
  Set pGlayer.ExclusionSet = pFeatureIDSet




End Sub