Problème objet en argument vba - VB/VBA/VBS - Programmation
Marsh Posté le 16-10-2007 à 17:05:52
salut,
il me semble que les fonctions que tu as écrites existent déjà mais bon
pourrais-tu nous donner ton code pour qu'on puisse te dire d'où vient l'ereur stp ?
Marsh Posté le 16-10-2007 à 17:15:25
ok le voici (je bosse sur un logiciel sig pour info)
Public Sub Recup_Prop_Click()
'=============================
'Déclaration des variables
Dim pMxDoc As IMxDocument 'Déclaration de mon document
Dim pMap As IMap 'Déclaration de mon bloc de données
Dim pParFLayer As IFeatureLayer 'Déclaration de ma couche
Dim pParFeature As IFeature 'Déclaration de mes entités
Dim pParSelection As IFeatureSelection 'Déclaration de ma sélection de parcelles
Dim pParSelectionset As ISelectionSet 'Déclaration de mon jeu de sélection
Dim pParCursor As IFeatureCursor 'Déclaration de mon curseur pour les parcelles
Dim pIDPROP As String 'Déclaration de ma variable pIDPROP
Dim pPropNom As String
'=============================
'Affectation des valeurs
Set pMxDoc = ThisDocument 'J'affecte mon document ouvert
Set pMap = pMxDoc.FocusMap 'J'affecte mon bloc de données actif
Set pParFLayer = FindLayerByName(pMap, "Parcelle" ) 'J'affecte le nom parcelle à pParFlayer
'=============================
'Traitement
CallCreationFichier (pFichierProp)
Set pParFeature = pParCursor.NextFeature 'Je me place sur le 1er élément de pParFeature
Do While Not pParFeature Is Nothing 'Boucle sur mes entités sélectionnées
pIDPROP = pParFeature.Value(pParFeature.Class.FindField("IDPROP" )) 'Récupération des valeurs du champ IDPROP de pParFeature
Call NomProprio(pIDPROP, pPropNom) 'J'appelle la fonction NomProprio
Call EcritureFichier(pPropNom, pFichierProp)
Set pParFeature = pParCursor.NextFeature
Loop
End Sub
Function CreationFichier(pFichierProp As Object)
'==========================
'Déclaration des variables
Dim fso As FileSystemObject 'Déclaration de mon filesystemobject afin de pointer sur le nom de mon fichier texte
Dim pFileProp As String 'Déclaration du chemin d'accès au fichier
'Dim pFichierProp As TextStream 'Déclaration de mon fichier texte qui sera créé dans mon chemin cité précédemment
'==========================
'Affectation des valeurs
Set fso = CreateObject("Scripting.FileSystemObject" ) 'je créé un objet dans mon fso
pFileProp = "D:\Test\Prog\Thibault\fichier_proprio.txt" 'J'affecte le chemin complet du fichier à ma variable pFileProp
If fso.FileExists(pFileProp) Then 'je teste si le fichier existe déjà
MsgBox "le fichier existe déjà", vbExclamation 's'il existe déjà j'envoie ce msg....
End If
Set pFichierProp = fso.CreateTextFile("D:\Test\Prog\Thibault\fichier_proprio.txt", True) '....je créé mon fichier texte en lui mettant le chemin en entier
End Function
Function EcritureFichier(pPropNom As String, pFichierProp As Object)
'Déclaration des variables
'Dim fso As FileSystemObject 'Déclaration de mon filesystemobject afin de pointer sur le nom de mon fichier texte
'Dim pFileProp As String 'Déclaration du chemin d'accès au fichier
'Dim pFichierProp As TextStream 'Déclaration de mon fichier texte qui sera créé dans mon chemin cité précédemment
'==========================
'Affectation des valeurs
'Set fso = CreateObject("Scripting.FileSystemObject" ) 'je créé un objet dans mon fso
'pFileProp = "D:\Test\Prog\Thibault\fichier_proprio.txt" 'J'affecte le chemin complet du fichier à ma variable pFileProp
'If fso.FileExists(pFileProp) Then 'je teste si le fichier existe déjà
'MsgBox "le fichier existe déjà", vbExclamation 's'il existe déjà j'envoie ce msg....
'End If
'Set pFichierProp = fso.CreateTextFile("D:\Test\Prog\Thibault\fichier_proprio.txt", True) '....je créé mon fichier texte en lui mettant le chemin en entier
'==========================
'Traitement (création du fichier)
With pFichierProp
.WriteLine "Numéro de parcelle - Identifiant propriétaire - Nom du propriétaire"
.WriteLine " - - " & pPropNom
End With
End Function
En espérant que vous puissiez m'aider.
Marsh Posté le 16-10-2007 à 17:25:52
Au niveau des appel dans la procédure Call CreationFichier(pFichierProp) et call EcritureFichier. ça vient de pFichierProp à mon humble avis.
Marsh Posté le 16-10-2007 à 17:31:14
Euh nan ça vient pas de là.J'ai bien un espace dans mon code.
Marsh Posté le 16-10-2007 à 17:35:24
ah oki,
et tu passes quoi en paramètre, puisque tu le redéfinis dans ta fonction...
Marsh Posté le 16-10-2007 à 17:38:57
bah en paramètre je mets son nom pFichierProp.
il faut que j'y aille on verra ça demain!
Marsh Posté le 17-10-2007 à 18:57:38
pFichierProp n'est définie nulle part
Je ne comprends pas ce que tu veux faire d'ailleurs
Peut-être qu'un "dim pFichierProp as object" résoudrait ton problème ?
Marsh Posté le 18-10-2007 à 09:15:41
Nan ça passe pas.En fait je souhaiterais juste récupérer à la fin de ma boucle mon fichier texte avec les infos dedans.
Marsh Posté le 18-10-2007 à 09:30:07
« Nan ça passe pas ». Il va falloir être plus clair.
Quelle modification as-tu apporté à ton code (copier/coller du code de préférence) ? L'erreur est-elle la même (son n° et son libellé exact stp) que précédemment ?
Où as-tu mis la définition de pFichierProp ?
Si tu pouvais virer le code en commentaires quand tu nous le proposes, ça serait plus clair aussi.
Marsh Posté le 18-10-2007 à 09:35:35
Bonjour,
Dans ta procedure, tu fais appel à CreationFichier avec un paramètre jamais définis au préalable.
Pas de définition et pas de valeur. C'est normal ?
Edit :
L'utilisation d'une fonction permet de passer des paramétres à cette fonction et de retourner une valeur associée à cette fonction.
En clair, function creationfichier(param1 as objet) as objet
ca veut dire que param1 est "valorisé" avant l'appel à la fonction.
et dans la fonction tu indiques
set creationfichier =Pfichier..
pour récupérer le résultat de ta fonction.
Marsh Posté le 18-10-2007 à 10:59:36
Bon alors j'ai nettoyé mon code,le voici sans commentaire:
Public Sub Recup_Prop_Click()
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pParFLayer As IFeatureLayer
Dim pParFeature As IFeature
Dim pParSelection As IFeatureSelection
Dim pParSelectionset As ISelectionSet
Dim pParCursor As IFeatureCursor
Dim pIDPROP As String
Dim pPropNom As String
Dim pFichierProp As TextStream
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pParFLayer = FindLayerByName(pMap, "Parcelle" )
Set pParSelection = pParFLayer
Set pParSelectionset = pParSelection.SelectionSet
pParSelectionset.Search Nothing, False, pParCursor
Call CreationFichier(pFichierProp)
Set pParFeature = pParCursor.NextFeature
Do While Not pParFeature Is Nothing
pIDPROP = pParFeature.Value(pParFeature.Class.FindField("IDPROP" ))
Call NomProprio(pIDPROP, pPropNom)
Call EcritureFichier(pPropNom, pFichierProp)
Set pParFeature = pParCursor.NextFeature
Loop
End Sub
Function NomProprio(pIDPROP As String, pPropNom As String)
Dim pMxDoc As IMxDocument
Dim pStTabColl As IStandaloneTableCollection
Dim pPropTab As ITable
Dim pTableDef As ITableDefinition
Dim i As Integer
Dim test As Integer
Dim pRow As IRow
Dim pPropCursor As ICursor
Dim pPropIndex As String
'Dim pPropNom As String
Set pMxDoc = ThisDocument
Set pStTabColl = pMxDoc.ActiveView
If pStTabColl.StandaloneTableCount = 0 Then
MsgBox "Veuillez ajouter la table proprio"
Exit Function
End If
test = 0
For i = 0 To pStTabColl.StandaloneTableCount - 1
If pStTabColl.StandaloneTable(i).Name = "proprio" Then
Set pPropTab = pStTabColl.StandaloneTable(i)
Set pTableDef = pPropTab
test = 1
Exit For
End If
Next i
If test = 0 Then
MsgBox "Veuillez ajouter la table proprio"
Exit Function
End If
pPropIndex = pPropTab.FindField("DDENOM" )
Set pPropCursor = pPropTab.Search(Nothing, True)
Set pRow = pPropCursor.NextRow
pTableDef.DefinitionExpression = "[IDPROP] = '" + pIDPROP + "'"
Do While Not pRow Is Nothing
pPropNom = pRow.Value(pPropIndex
Set pRow = pPropCursor.NextRow
Loop
End Function
Function CreationFichier(pFichierProp As TextStream) As TextStream
Dim fso As FileSystemObject
Dim pFileProp As String
'Dim pFichierProp As TextStream
Set fso = CreateObject("Scripting.FileSystemObject" )
pFileProp = "D:\Test\Prog\Thibault\fichier_proprio.txt"
If fso.FileExists(pFileProp) Then
MsgBox "le fichier existe déjà", vbExclamation
End If
Set pFichierProp = fso.CreateTextFile("D:\Test\Prog\Thibault\fichier_proprio.txt", True)
Set CreationFichier = pFichierProp
End Function
Function EcritureFichier(pPropNom As String, pFichierProp As TextStream)
With pFichierProp
.WriteLine = "Numéro de parcelle - Identifiant propriétaire - Nom du propriétaire"
.WriteLine " - - " & pPropNom
End With
End Function
J'ai essayé avec ce que tu m'as indiqué paul hood mais rien n'y fait,j'ai le msg fonction ou variable attendue à ma dernière ligne quand je veux écrire dans le fichier. Est ce que ça ne vient pas de l'objet pFichierProp en lui-même qui est un textStream?
Pour Tegu pFichierProp est un textStream créé dans un FSO.
Marsh Posté le 18-10-2007 à 11:24:31
J'ai modifié ton code :
Public Sub Recup_Prop_Click()
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pParFLayer As IFeatureLayer
Dim pParFeature As IFeature
Dim pParSelection As IFeatureSelection
Dim pParSelectionset As ISelectionSet
Dim pParCursor As IFeatureCursor
Dim pIDPROP As String
Dim pPropNom As String
Dim pFichierProp As TextStream
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pParFLayer = FindLayerByName(pMap, "Parcelle" )
Set pParSelection = pParFLayer
Set pParSelectionset = pParSelection.SelectionSet
pParSelectionset.Search Nothing, False, pParCursor
'ICI=================
pFichierProp= CreationFichier()
'JUSQU'ICI============
Set pParFeature = pParCursor.NextFeature
Do While Not pParFeature Is Nothing
pIDPROP = pParFeature.Value(pParFeature.Class.FindField("IDPROP" ))
Call NomProprio(pIDPROP, pPropNom)
Call EcritureFichier(pPropNom, pFichierProp)
Set pParFeature = pParCursor.NextFeature
Loop
End Sub
Function NomProprio(pIDPROP As String, pPropNom As String)
Dim pMxDoc As IMxDocument
Dim pStTabColl As IStandaloneTableCollection
Dim pPropTab As ITable
Dim pTableDef As ITableDefinition
Dim i As Integer
Dim test As Integer
Dim pRow As IRow
Dim pPropCursor As ICursor
Dim pPropIndex As String
'Dim pPropNom As String
Set pMxDoc = ThisDocument
Set pStTabColl = pMxDoc.ActiveView
If pStTabColl.StandaloneTableCount = 0 Then
MsgBox "Veuillez ajouter la table proprio"
Exit Function
End If
test = 0
For i = 0 To pStTabColl.StandaloneTableCount - 1
If pStTabColl.StandaloneTable(i).Name = "proprio" Then
Set pPropTab = pStTabColl.StandaloneTable(i)
Set pTableDef = pPropTab
test = 1
Exit For
End If
Next i
If test = 0 Then
MsgBox "Veuillez ajouter la table proprio"
Exit Function
End If
pPropIndex = pPropTab.FindField("DDENOM" )
Set pPropCursor = pPropTab.Search(Nothing, True)
Set pRow = pPropCursor.NextRow
pTableDef.DefinitionExpression = "[IDPROP] = '" + pIDPROP + "'"
Do While Not pRow Is Nothing
pPropNom = pRow.Value(pPropIndex
Set pRow = pPropCursor.NextRow
Loop
End Function
'ICI================
Function CreationFichier() As TextStream
Dim fso As FileSystemObject
Dim pFileProp As String
Set fso = CreateObject("Scripting.FileSystemObject" )
pFileProp = "D:\Test\Prog\Thibault\fichier_proprio.txt"
If fso.FileExists(pFileProp) Then
MsgBox "le fichier existe déjà", vbExclamation
End If
Set CreationFichier = fso.CreateTextFile("D:\Test\Prog\Thibault\fichier_proprio.txt", True)
End Function
'JUSQU'ICI==================
Function EcritureFichier(pPropNom As String, pFichierProp As TextStream)
With pFichierProp
.WriteLine = "Numéro de parcelle - Identifiant propriétaire - Nom du propriétaire"
.WriteLine " - - " & pPropNom
End With
End Function
J'ai modifié ton code.
J'espère que ca t'aidera
Marsh Posté le 18-10-2007 à 11:35:09
J'ai un message d'erreur après le End function de CreationFichier "variable objet ou variable with non définie", un truc comme ça.Mais c'est une piste à creuser.
Marsh Posté le 18-10-2007 à 13:51:07
Juste pour être sûr, tu as bien la bibliothèque « Microsoft Scripting Runtime » en référence de ton projet ?
La compilation du module (je suppose qu'il s'agit d'un module) se passe bien ?
edit: juste un truc dans CreationFichier(), tu initialises pFileProp mais tu ne l'utilises pas avec fso.CreateTextFile(...) ; ça résoudra pas ton problème, mais ça peut en éviter de futurs
Marsh Posté le 18-10-2007 à 14:13:08
Oui j'ai bien mis la bibliothèque "Microsoft Scripting Runtime " dans le projet.
La compilation se passe également bien.
Vraiment je vois pas d'où ça vient.
Marsh Posté le 18-10-2007 à 14:35:01
Oups...un oubli !!!
remplace pFichierProp= CreationFichier() par
Set pFichierProp= CreationFichier()
dans ta procédure générale.
Je pense que tu vas avoir le même probème (parametres de la fonction et valeur affectée à la fonction) pour tes autres fonctions.
Marsh Posté le 18-10-2007 à 14:42:46
ReplyMarsh Posté le 18-10-2007 à 14:43:43
kael81 a écrit : Pfff ça m'agace!!!!!ça bug à la fin j'ai un message "objet requis"!!!!! |
A la fin de quoi ?
Marsh Posté le 18-10-2007 à 14:51:24
quand j'arrive sur le with pFichierProp.write dans la fonction EcritureFichier
Marsh Posté le 18-10-2007 à 15:08:39
c'est bon ça passe merci à tous!!!!
Pour la fin fallait mettre with CreationFichier.Write.....
Encore merci
Marsh Posté le 18-10-2007 à 15:13:23
Remplace
With pFichierProp
.WriteLine ="Numéro de parcelle - Identifiant propriétaire - Nom du propriétaire"
par
With pFichierProp
.WriteLine ("Numéro de parcelle - Identifiant propriétaire - Nom du propriétaire" )
Marsh Posté le 16-10-2007 à 15:56:28
Salut à tous,je débute en vba et je bloque à un moment donné.
Voilà j'ai fais une fonction qui me permet de créer un fichier texte et une autre qui me permet d'écrire dans ce fichier.Cette dernière me renvoie un textStream. Le problème est que j'appelle cette fonction d'une procédure plus haut avec comme argument la variable du textStream mais à chaque fois j'ai un msg d'erreur "type incompatible.." un truc comme ça. Alors je vois pas trop ce que je peux faire et je vous supplie de m'aider.
merci d'avance