Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1818 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Problème objet en argument vba

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Problème objet en argument vba

n°1624803
kael81
Posté le 16-10-2007 à 15:56:28  profilanswer
 

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

mood
Publicité
Posté le 16-10-2007 à 15:56:28  profilanswer
 

n°1624849
jpcheck
Pioupiou
Posté le 16-10-2007 à 17:05:52  profilanswer
 

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 ?

n°1624856
kael81
Posté le 16-10-2007 à 17:15:25  profilanswer
 

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.

n°1624860
jpcheck
Pioupiou
Posté le 16-10-2007 à 17:16:50  profilanswer
 

a quel niveau une erreur apparait-elle stp ?

n°1624867
kael81
Posté le 16-10-2007 à 17:25:52  profilanswer
 

Au niveau des appel dans la procédure Call CreationFichier(pFichierProp) et call EcritureFichier. ça vient de pFichierProp à mon humble avis.

n°1624871
jpcheck
Pioupiou
Posté le 16-10-2007 à 17:27:44  profilanswer
 

il manque une espace entre Call et CreationFichier :)

n°1624874
kael81
Posté le 16-10-2007 à 17:31:14  profilanswer
 

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

n°1624876
jpcheck
Pioupiou
Posté le 16-10-2007 à 17:35:24  profilanswer
 

ah oki,
et tu passes quoi en paramètre, puisque tu le redéfinis dans ta fonction...

n°1624881
kael81
Posté le 16-10-2007 à 17:38:57  profilanswer
 

bah en paramètre je mets son nom pFichierProp.
il faut que j'y aille on verra ça demain!

n°1625902
devil_k
Posté le 17-10-2007 à 18:57:38  profilanswer
 

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 ?

mood
Publicité
Posté le 17-10-2007 à 18:57:38  profilanswer
 

n°1626135
kael81
Posté le 18-10-2007 à 09:15:41  profilanswer
 

Nan ça passe pas.En fait je souhaiterais juste récupérer à la fin de ma boucle mon fichier texte avec les infos dedans.

n°1626147
tegu
Posté le 18-10-2007 à 09:30:07  profilanswer
 

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

n°1626158
Paul Hood
Posté le 18-10-2007 à 09:35:35  profilanswer
 

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
n°1626235
kael81
Posté le 18-10-2007 à 10:59:36  profilanswer
 

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.

n°1626249
Paul Hood
Posté le 18-10-2007 à 11:24:31  profilanswer
 

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

n°1626255
kael81
Posté le 18-10-2007 à 11:35:09  profilanswer
 

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.

n°1626344
tegu
Posté le 18-10-2007 à 13:51:07  profilanswer
 

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
n°1626383
kael81
Posté le 18-10-2007 à 14:13:08  profilanswer
 

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.

n°1626431
Paul Hood
Posté le 18-10-2007 à 14:35:01  profilanswer
 

: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
n°1626456
kael81
Posté le 18-10-2007 à 14:42:46  profilanswer
 

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

n°1626457
Paul Hood
Posté le 18-10-2007 à 14:43:43  profilanswer
 

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 ?

n°1626474
kael81
Posté le 18-10-2007 à 14:51:24  profilanswer
 

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

n°1626500
kael81
Posté le 18-10-2007 à 15:08:39  profilanswer
 

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

n°1626511
Paul Hood
Posté le 18-10-2007 à 15:13:23  profilanswer
 

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

mood
Publicité
Posté le   profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Problème objet en argument vba

 

Sujets relatifs
Probleme de date chez client mais pas chez moi[Résolu] Problème avec la fonction Ubound
problème de comptage ...probleme lors de compilation module manquant
aidez moi SVP...j'ai un problèmeProbleme de requête SQL
Probleme avec GetFileSecurityProbleme de charset
[Actionscript/Flash] Probleme de son qui demare automatiquementProbleme avec mes div
Plus de sujets relatifs à : Problème objet en argument vba


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR