AO+VB 请总统帮忙 请看代码

<P>  Dim pMxDoc As IMxDocument<BR>  Dim pUnknown As IUnknown<BR>  Dim pLayer As ILayer<BR>  Dim pStandaloneTable As IStandaloneTable<BR>  Dim pTableWindow2 As ITableWindow2<BR>  Dim pExistingTableWindow As ITableWindow<BR>  Dim SetProperties As Boolean<BR>  <BR>  'Get the selected item from the current contents view<BR>  Set pMxDoc = ThisDocument<BR>  Set pTableWindow2 = New TableWindow<BR>  Set pUnknown = pMxDoc.SelectedItem<BR>  <BR>  ' Determine the selected item's type<BR>  ' Exit sub if item is not a feature layer or standalone table<BR>  If TypeOf pUnknown Is IFeatureLayer Then 'A FeatureLayer<BR>    Set pLayer = pUnknown<BR>    Set pExistingTableWindow = _<BR>    pTableWindow2.FindViaLayer(pLayer)<BR>    ' Check if a table already exists; if not create one<BR>    If pExistingTableWindow Is Nothing Then<BR>      Set pTableWindow2.Layer = pLayer<BR>      SetProperties = True<BR>    End If<BR>  ElseIf TypeOf pUnknown Is IStandaloneTable Then<BR>    ' A standalone table<BR>    Set pStandaloneTable = pUnknown<BR>    Set pExistingTableWindow = _<BR>    pTableWindow2.FindViaStandaloneTable(pStandaloneTable)<BR>    ' Check if a table already exists; if not, create one<BR>    If pExistingTableWindow Is Nothing Then<BR>      Set pTableWindow2.StandaloneTable = pStandaloneTable<BR>      SetProperties = True<BR>    End If<BR>  End If<BR>  <BR>  If SetProperties Then<BR>    pTableWindow2.TableSelectionAction = esriSelectFeatures<BR>    pTableWindow2.ShowSelected = False<BR>    pTableWindow2.ShowAliasNamesInColumnHeadings = True<BR>    Set pTableWindow2.Application = Application<BR>  Else<BR>    Set pTableWindow2 = pExistingTableWindow<BR>  End If<BR>  <BR>  ' Ensure Table Is Visible<BR>  If Not pTableWindow2.IsVisible Then pTableWindow2.Show True<BR>  <BR>End Sub</P>
<P>这是打开属性表的程序 为什么在VBA里面可以 在MAPCOTROL里不可以</P>
<P> 运行到Set pTableWindow2.Application = Application  出现错误“ACTIVEX不能创建对象”<BR>请问各位高手应该如何改</P>
<P>谢谢！！</P>

<P>iApplication只在arcgis里有效，具体你可以参看帮助说明</P>
<P>如果要使用arcgis里的对话框来显示要素属性，可以使用下面的代码，</P>
<P>这是使用icommand，你可以放在一个工具（tool）上使用</P><PRE>Option Explicit

Implements ICommand
Implements ITool

Private m_pMap As IMap
Private m_bEnable As Boolean

Private Sub Class_Terminate()
     On Error Resume Next
    
     Set m_pMap = Nothing
End Sub

Private Property Get ICommand_Bitmap() As esricore.OLE_HANDLE
     On Error Resume Next

     ICommand_Bitmap = frmResources.picIdentifyBmp.Picture.Handle
End Property

Private Property Get ICommand_Caption() As String
     On Error Resume Next

     ICommand_Caption = "Identify Tool"
End Property

Private Property Get ICommand_Category() As String
     On Error Resume Next

     ICommand_Category = "Tools"
End Property

Private Property Get ICommand_Checked() As Boolean
     On Error Resume Next

     ICommand_Checked = False
End Property

Private Property Get ICommand_Enabled() As Boolean
     On Error Resume Next

     ICommand_Enabled = (m_pMap.LayerCount > 0)
End Property

Private Property Get ICommand_HelpContextID() As Long

End Property

Private Property Get ICommand_HelpFile() As String

End Property

Private Property Get ICommand_Message() As String
     On Error Resume Next

     ICommand_Message = "Identify features by clicking them with the mouse"
End Property

Private Property Get ICommand_Name() As String
     On Error Resume Next

     ICommand_Name = "Identify Tool"
End Property

Private Sub ICommand_OnClick()
    
End Sub

Private Sub ICommand_OnCreate(ByVal Hook As Object)
     Dim pApplication As IApplication
     Dim pMxDocument As IMxDocument
     Dim pMapControl As esriMapControl.IMapControl2
    
     On Error GoTo ErrorHandler
    
     ' Get a reference to the map.
     If TypeOf Hook Is IApplication Then
          Set pApplication = Hook
          Set pMxDocument = pApplication.Document
          Set m_pMap = pMxDocument.FocusMap
          m_bEnable = True
     ElseIf TypeOf Hook Is IMapControl2 Then
          Set pMapControl = Hook
          Set m_pMap = pMapControl.Map
          m_bEnable = True
     End If
Exit Sub
ErrorHandler:
     ErrorMessage "clsIdentifyTool:ICommand_OnCreate()"
End Sub

Private Property Get ICommand_Tooltip() As String
     On Error Resume Next

     ICommand_Tooltip = "Identify Tool"
End Property

Private Property Get ITool_Cursor() As esricore.OLE_HANDLE
     On Error Resume Next

     ITool_Cursor = frmResources.picIdentifyCur.Picture.Handle
End Property

Private Function ITool_Deactivate() As Boolean
     On Error Resume Next

     ITool_Deactivate = True
End Function

Private Function ITool_OnContextMenu(ByVal x As Long, ByVal y As Long) As Boolean

End Function

Private Sub ITool_OnDblClick()

End Sub

Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long)

End Sub

Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long)

End Sub

Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
     Dim pActiveView As IActiveView
     Dim pPoint As IPoint
     Dim pIdentifyDlg As IIdentifyDialog
     Dim pIdentifyDlg2 As IIdentifyDialog2
     Dim pIdentifyDlgProps As IIdentifyDialogProps
     Dim pEnumLayer As IEnumLayer
     Dim pLayer As ILayer
    
     On Error GoTo ErrorHandler
    
     If Button <> vbLeftButton Then Exit Sub
    
     ' Get click point.
     Set pActiveView = m_pMap
     Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
    
     ' Setup Identify dialog.
     Set pIdentifyDlg = New IdentifyDialog
     Set pIdentifyDlg.Map = m_pMap
     Set pIdentifyDlg.display = pActiveView.ScreenDisplay
    
     ' Hide the context menu.
     Set pIdentifyDlg2 = pIdentifyDlg
     pIdentifyDlg2.HideContextMenu = True
    
     ' Get the identify layers.
     Set pIdentifyDlgProps = pIdentifyDlg
     Set pEnumLayer = pIdentifyDlgProps.Layers
    
     ' Clear current identify features.
     pIdentifyDlg.ClearLayers
    
     ' Identify features at click point.
     pEnumLayer.Reset
     Set pLayer = pEnumLayer.Next
     Do While Not pLayer Is Nothing
          pIdentifyDlg.AddLayerIdentifyPoint pLayer, x, y
          
          Set pLayer = pEnumLayer.Next
     Loop
    
     ' Show the dialog.
     pIdentifyDlg.Show
Exit Sub
ErrorHandler:
     ErrorMessage "clsIdentifyTool:ITool_OnMouseDown()"
End Sub

Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)

End Sub

Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)

End Sub

Private Sub ITool_Refresh(ByVal hDc As esricore.OLE_HANDLE)

End Sub
</PRE>