Problème objet en argument vba

Problème objet en argument vba - VB/VBA/VBS - Programmation

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

Reply

Marsh Posté le 16-10-2007 à 15:56:28   

Reply

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  [:jpcheck]  
 
pourrais-tu nous donner ton code pour qu'on puisse te dire d'où vient l'ereur stp ?

Reply

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.

Reply

Marsh Posté le 16-10-2007 à 17:16:50    

a quel niveau une erreur apparait-elle stp ?

Reply

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.

Reply

Marsh Posté le 16-10-2007 à 17:27:44    

il manque une espace entre Call et CreationFichier :)

Reply

Marsh Posté le 16-10-2007 à 17:31:14    

Euh nan ça vient pas de là.J'ai bien un espace dans mon code.

Reply

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...

Reply

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!

Reply

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 :spamafote:
 
Peut-être qu'un "dim pFichierProp as object" résoudrait ton problème ?

Reply

Marsh Posté le 17-10-2007 à 18:57:38   

Reply

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.

Reply

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.

Reply

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.


Message édité par Paul Hood le 18-10-2007 à 09:53:31
Reply

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.

Reply

Marsh Posté le 18-10-2007 à 11:24:31    

J'ai modifié ton code : :bounce:  
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================= :hello:  
    pFichierProp= CreationFichier()
'JUSQU'ICI============ :hello:  
   
    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================ :hello:  
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================== :hello:  
 
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. :bounce:  
J'espère que ca t'aidera

Reply

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.

Reply

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


Message édité par tegu le 18-10-2007 à 13:56:01
Reply

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.

Reply

Marsh Posté le 18-10-2007 à 14:35:01    

:non: 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. :(


Message édité par Paul Hood le 18-10-2007 à 14:40:00
Reply

Marsh Posté le 18-10-2007 à 14:42:46    

Pfff ça m'agace!!!!!ça bug  à la fin j'ai un message "objet requis"!!!!! :fou:  :fou:  :fou:  :fou:

Reply

Marsh 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"!!!!! :fou:  :fou:  :fou:  :fou:


A la fin de quoi ?

Reply

Marsh Posté le 18-10-2007 à 14:51:24    

quand j'arrive sur le with pFichierProp.write dans la fonction EcritureFichier

Reply

Marsh Posté le 18-10-2007 à 15:08:39    

c'est bon ça passe merci à tous!!!! :love:  :love:  
Pour la fin fallait mettre with CreationFichier.Write.....
Encore merci

Reply

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" )

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed