i find the solution :Button Parcourir :
Private Sub CmdPrc_Click()
Dim pGxDialog As IGxDialog
Dim pTabFilter As IGxObjectFilter
Dim pEnumGx As IEnumGxObject
Set pTabFilter = New GxFilterTables
Set pGxDialog = New GxDialog
Set pGxDialog.ObjectFilter = pTabFilter
pGxDialog.AllowMultiSelect = True
pGxDialog.RememberLocation = True
pGxDialog.Title = "Browse Data"
If Not pGxDialog.DoModalOpen(0, pEnumGx) Then
Exit Sub
'Exit if user press Cancel
End If
' ---- Added Code ----
Dim pGxObj As IGxObject
Dim pName As IName
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pSATblColl As IStandaloneTableCollection
Dim pSATbl As IStandaloneTable
Do
' Get the selected object
Set pGxObj = pEnumGx.Next
If pGxObj Is Nothing Then Exit Do
Set pName = pGxObj.InternalObjectName
' Check it's a table
If TypeOf pName Is ITableName Then
If pGxObj.Category = "dBASE Table" Then
' Create a new standalone table using the selected table
Set pSATbl = New StandaloneTable
On Error GoTo error
Set pSATbl.Table = pName.Open
' Add it to the map
RemoveEverythingTOC
RemoveStandAloneTables
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pSATblColl = pMap
pSATblColl.AddStandaloneTable pSATbl
' Update the TOC (tables appear under the Source tab)
pMxDoc.UpdateContents
populatetable
Else
MsgBox "Ce type de fichiers n'est pas supporter, veuillez choisir un fichier <*.dbf>"
Exit Sub
End If
End If
Text1.Text = pGxDialog.FinalLocation.FullName & "\" & CmboDbf.Text & ".dbf"
few = 4
nbr = Len(Text1.Text)
pos = LastOccurence(Text1.Text, "\")
L = nbr - (few + pos)
D = nbr - (L + few)
Name = Mid(Text1.Text, pos + 1, L)
Dir = Mid(Text1.Text, 1, D)
Loop
Exit Sub
error:
If Err.Number = -2147219886 Then
MsgBox "Format Not Support"
TextBox1.Text = ""
CmboDbf.Clear
CmboX.Clear
CmboY.Clear
Else
MsgBox "Error occured adding the table. " & Err.Description & vbNewLine & _
" Error Number: " & "(" & Err.Number & ")", _
vbExclamation, "Error"
TextBox1.Text = ""
CmboDbf.Clear
CmboX.Clear
CmboY.Clear
Exit Sub
End If
'******************************************
'Procedure to add a dbf table to the map
'******************************************
Dim pFact As IWorkspaceFactory
Dim pWorkspace As IWorkspace
Dim pFeatws As IFeatureWorkspace
Dim pTable As ITable
Set pFact = New ShapefileWorkspaceFactory
Dim strOpenPath As String
Dim strOpenTable As String
Dim strTableNamewithPath As String
strTableNamewithPath = Text1.Text 'Files path location
Dim strRev As String
strRev = StrReverse(strTableNamewithPath)
strRev = Mid(strRev, 1, InStr(1, strRev, "\") - 1)
strOpenTable = StrReverse(strRev)
strOpenPath = Mid(strTableNamewithPath, 1, InStr(1, strTableNamewithPath, strOpenTable) - 1)
Set pWorkspace = pFact.OpenFromFile(strOpenPath, 0)
Set pFeatws = pWorkspace
Set pTable = pFeatws.OpenTable(strOpenTable)
'add the table
Add_Table_TOC pTable
Sub populatetable()
'Loop through the standalone tables in a map
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pStandaloneTableCollection As IStandaloneTableCollection
Dim pStandaloneTable As IStandaloneTable
Dim pTable As ITable
'Get the current map from the document
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
'Get the table collection from the map
CmboDbf.Clear
Dim i As Long
Set pStandaloneTableCollection = pMap
For i = 0 To pStandaloneTableCollection.StandaloneTableCount - 1
Set pStandaloneTable = pStandaloneTableCollection.StandaloneTable(i)
CmboDbf.AddItem pStandaloneTable.Name
Next
If CmboDbf.ListCount > 0 Then CmboDbf.ListIndex = 0
End Sub
Private Sub Add_Table_TOC(pTable As ITable)
'****************************************************************
'Procedure to add the table to Table of Contents of the Map.
'****************************************************************
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim intCol As Integer
Dim blnExists As Boolean
Dim pFeatws As IFeatureWorkspace
Dim pWorkspace As IWorkspace
Dim pFact As IWorkspaceFactory
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
' Create a new standalone table and add it
' to the collection of the focus map
Dim pStTab As IStandaloneTable
Set pStTab = New StandaloneTable
Set pStTab.Table = pTable
Dim pStTabColl As IStandaloneTableCollection
Set pStTabColl = pMap
For intCol = 0 To pStTabColl.StandaloneTableCount - 1
If pStTabColl.StandaloneTable(intCol).Name = pStTab.Name Then
blnExists = True
Exit For
End If
Next
Dim i As Integer
For i = 0 To pDoc.ContentsViewCount - 1
If pDoc.ContentsView(i).Name = "Source" Then
Set pDoc.CurrentContentsView = pDoc.ContentsView(i)
Exit For
End If
Next i
If blnExists = False Then
pStTabColl.AddStandaloneTable pStTab
End If
' Refresh the TOC
pDoc.UpdateContents
Set pDoc = Nothing
Set pStTabColl = Nothing
Set pMap = Nothing
Set pStTabColl = Nothing
Set pTable = Nothing
Set pFeatws = Nothing
Set pWorkspace = Nothing
Set pFact = Nothing
End Sub
Button Editer :
Private Sub CmdEdt_Click() ' Set the Spatial Reference for Point1
'On Error GoTo et
Dim pDialog As ISpatialReferenceDialog
Set pDialog = New SpatialReferenceDialog
' Dim pSpatialReference As ISpatialReference a declarer au debut de la form public, pour l'affecter a (set pXYEventSourceName.SpatialReference = pSpatialReference)
Set pSpatialReference = pDialog.DoModalCreate(False, False, False, Form1.ActiveControl)
If pSpatialReference Is Nothing Then
MsgBox "Veuillez choisir un System de projection !"
ElseIf TextBox1.Text = "" Then
MsgBox "Veuillez choisir un fichier <.dbf> "
Exit Sub
Else
TextBox1.Text = "Projected Coordinate System_" & "Name: " & pSpatialReference.Name
End If
'et:
'HandleError
End Sub
Button Ok :
Private Sub CmdOk_Click()
'On Error GoTo EH
Dim pDoc As IMxDocument
Dim pMap As IMap
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
' Get the table named Table.dbf or txt...
Dim pStTabCol As IStandaloneTableCollection
Dim pStandaloneTable As IStandaloneTable
Dim intCount As Integer
Dim pTable As ITable
Set pStTabCol = pMap
For intCount = 0 To pStTabCol.StandaloneTableCount - 1
Set pStandaloneTable = pStTabCol.StandaloneTable(intCount)
If pStandaloneTable.Name = Name Then
Set pTable = pStandaloneTable.Table
Exit For
End If
Next intCount
If pTable Is Nothing Then
MsgBox "Veuillez ajouter une table"
Exit Sub
End If
If CmboX.Text = "" Or CmboY.Text = "" Then
MsgBox "Veuillez choisir les coordonnées XY !"
Exit Sub
End If
If pSpatialReference Is Nothing Then
MsgBox "Veuillez choisir un System de projection !"
Exit Sub
End If
' Get the table name object
Dim pDataset As IDataset
Dim pTableName As IName
Set pDataset = pTable
Set pTableName = pDataset.FullName
' Specify the X and Y fields
Dim pXYEvent2FieldsProperties As IXYEvent2FieldsProperties
Set pXYEvent2FieldsProperties = New XYEvent2FieldsProperties
With pXYEvent2FieldsProperties
.XFieldName = CmboX.Text
.YFieldName = CmboY.Text
End With
' Specify the projection
If pSpatialReference Is Nothing Then
MsgBox "Veuillez choisir un System de projection !"
Exit Sub
Else
' Create the XY name object and set it's properties
Dim pXYEventSourceName As IXYEventSourceName
Dim pXYName As IName
Dim pXYEventSource As IXYEventSource
Set pXYEventSourceName = New XYEventSourceName
With pXYEventSourceName
Set .EventProperties = pXYEvent2FieldsProperties
Set .SpatialReference = pSpatialReference
Set .EventTableName = pTableName
End With
Set pXYName = pXYEventSourceName
Set pXYEventSource = pXYName.Open
End If
' Create a new Map Layer
Dim pFLayer As IFeatureLayer
Set pFLayer = New FeatureLayer
Set pFLayer.FeatureClass = pXYEventSource
pFLayer.Name = "Points Spacialisés"
'Add the layer extension (this is done so that when you edit
'the layer's Source properties and click the Set Data Source
'button, the Add XY Events Dialog appears)
Dim pLayerExt As ILayerExtensions
Dim pRESPageExt As New XYDataSourcePageExtension
Set pLayerExt = pFLayer
pLayerExt.AddExtension pRESPageExt
pMap.AddLayer pFLayer
Exit Sub
Unload Me
EH:
HandleError
End Sub
