如何拷贝属性表中的一行

本例要实现的是如何将所有属性表（Attribute Table）中的行拷贝到Windows剪贴板，使用户能使用文本编辑器等软件对选中的数据做进一步编辑，从而满足特殊要求。行中的每个属性用半角字符的逗号“,”分隔，行间用换行符分隔。

l   要点

首先需要取得某属性表中的所有选中记录的全部属性，以一个字符串来存储。因为在属性表中选取中记录（Row）后，层中的相应记录（Feature）也将选中。两种途径都能获得所需属性值。

得到所需的字符串sResult后，就可以将其拷贝到剪贴板。在VB中剪贴板是全局对象。可像如下使用：

Clipboard.Clear

Clipboard.SetText  sResult

本例将在VBA中实现相同的功能。用到了IGraphicsContianer、IGraphicsContainerSelect、ITextElement、IElement、IClipboardFormat接口。

l   程序说明

过程UIBCopyRow_Click是实现模块，调用过程CopyRow实现功能。过程CopyRow将选中行的全部属性值（忽略Shape属性）连接成字符串，然后创建TextElement对象，并添加到IGraphicsContainer对象的选择集中，再调用TextClipboardFormat的Copy方法，把字符拷贝到Windows剪贴板。

l   代码

Option Explicit

Private Sub UIBCopyRow_Click()

    Call CopyRow

End Sub 

Public Sub CopyRow()

    Dim pMxDocument             As IMxDocument

    Dim pMap                    As IMap

    Dim pActiveView             As IActiveView

    Dim pGraphicsContainer      As IGraphicsContainer

    Dim pGraphicsContainerS     As IGraphicsContainerSelect

    Dim pFields                 As IFields

    Dim iCounter                As Integer

    Dim iIndex                  As Integer

    Dim pTextElement            As ITextElement

    Dim pElement                As IElement

    Dim sResult                 As String

    Dim pEnumFeature            As IEnumFeature

    Dim pEnumFeatureS           As IEnumFeatureSetup

    Dim pFeature                As IFeature

    Dim pClipboardFormat        As IClipboardFormat

    On Error GoTo ErrorHandler

    ' Used for string operation on the clipboard

    Set pClipboardFormat = New TextClipboardFormat

    Set pMxDocument = ThisDocument

    Set pActiveView = pMxDocument.ActivatedView

    Set pMap = pMxDocument.FocusMap

    Set pGraphicsContainer = pMap

    ' Get selected features to retieve their attribute values

    Set pEnumFeature = pMap.FeatureSelection

    Set pEnumFeatureS = pEnumFeature

    pEnumFeatureS.AllFields = True

    Set pFeature = pEnumFeature.Next

    If pFeature Is Nothing Then

        MsgBox "No row selected"

        Exit Sub

    End If

    Set pFields = pFeature.Fields

    iCounter = pFields.FieldCount

    Do Until pFeature Is Nothing

        For iIndex = 0 To iCounter - 1

            If Not TypeOf pFeature.Value(iIndex) Is IGeometry Then

                sResult = sResult & pFeature.Value(iIndex) & ","

            End If

        Next iIndex

        ' Remove the trailing comma

        sResult = Left(sResult, Len(sResult) - 1)

        sResult = sResult & vbNewLine

        Set pFeature = pEnumFeature.Next

    Loop

    ' If you're tending to build a dll to implement the same function and

    '  programming in VB enviroment, simply use the next to statement

    '  to copy the string into windows clippboard

    '       Clipboard.Clear

    '       Clipboard.SetText sResult

    ' Otherwise, programe as follows

    ' Copy the string into clippboard using objects included in esriCore

   

    ' To clear clippboard

    pClipboardFormat.Paste pMxDocument

    pGraphicsContainer.DeleteAllElements

    ' Construct a new TextElement with the string to copy into clipboard

    Set pTextElement = New TextElement

    pTextElement.Text = sResult

    Set pElement = pTextElement

    ' Point(100, 100) is for temporary use

    pElement.Geometry = pActiveView.ScreenDisplay.DisplayTransformation _

                        .ToMapPoint(100, 100)

    Set pGraphicsContainer = pMap

    pGraphicsContainer.AddElement pElement, 0

    Set pGraphicsContainerS = pGraphicsContainer

    pGraphicsContainerS.UnselectAllElements

    pGraphicsContainerS.SelectElement pElement

    pClipboardFormat.copy pMxDocument

    pGraphicsContainerS.UnselectElement pElement

    pGraphicsContainer.DeleteElement pElement

    pActiveView.Refresh

    Exit Sub

ErrorHandler:

    MsgBox Err.Description

End Sub