Un programme psychologue

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 617 fois - Téléchargée 88 fois

Contenu du snippet

Un petit jeu sur la reponse à des phrases.
C'est un amusement et je pense un source interressant sur le découpage et analyse de mots dans une phrases.
Vous devez créer un écran avec :
-Un label explicatif
-Une zone de saisie
-Un bouton d'analyse
-Un label pour les réponses de l'ordinateur

Source / Exemple :


'
' VIENT GERARD(FRANCE)
' TRES IMPORTANT CE PROGRAMME NE REMPLACE PAR UN PSYCHOLOGUE
' IL DOIT ETRE CONSIDERER COMME UN AMUSEMENT
' Pour ceux qui font de la micro-informatique depuis longtemps
' ils se rapelleront des programmes de l'ordinateur individuel !
'
' cette variable sert dans le cas d'une repetition
'
Dim totalmots, infoje, infoinsulte, infoexcla, infointer, infovous, infopere, infomere, infoargent, elle, il

Private Sub CommandButton1_Click()
'
' on etablit un diagnostic
'
Label2.Caption = "RESULTAT DE VOTRE ANALYSE :" + Chr(13)
'
' il faut avoir parler assez
'
If totalmots < 100 Then
   Label2.Caption = Label2.Caption + "Vous n'avez pas assez parlé.L'analyse risque d'être très incomplète." + Chr(13)
End If
'
' relation avec le travail
'
Select Case infotravail
   Case Is > 10
      Label2.Caption = Label2.Caption + "Il y as trop de place au monde du travail dans votre vie." + Chr(13)
   Case Is > 4
      Label2.Caption = Label2.Caption + "Le travail participe activement à votre vie." + Chr(13)
   Case Is >= 0
      Label2.Caption = Label2.Caption + "Vous parlez peu de votre travail." + Chr(13)
End Select

'
' relations avec la mere
'
Select Case infomere
  Case Is > 10
     Label2.Caption = Label2.Caption + "Visiblement votre mère a une trop grande place dans votre vie." + Chr(13)
  Case Is > 4
     Label2.Caption = Label2.Caption + "Votre mère est un élément important de votre vie." + Chr(13)
End Select
'
' relation avec le pere
'
Select Case infopere
   Case Is > 10
      Label2.Caption = Label2.Caption + "Votre père vous a énormement marqué!" + Chr(13)
   Case Is > 4
      Label2.Caption = Label2.Caption + "L'influence de votre père, apparait dans notre discussion." + Chr(13)
End Select
'
' relation avec l'argent
'
Select Case infoargent
   Case Is > 10
      Label2.Caption = Label2.Caption + "Il faut absolument prendre de la distance par rapport à l'argent." + Chr(13)
   Case Is > 4
      Label2.Caption = Label2.Caption + "L'argent n'est pas tout dans la vie!" + Chr(13)
End Select
'
' analyse des insultes
'
Select Case infoinsulte
   Case Is > 10
      Label2.Caption = Label2.Caption + "Vous avez trop tendance à insulter les gens." + Chr(13)
   Case Is > 4
      Label2.Caption = Label2.Caption + "Mefiez vous d'une tendance à vous enerver." + Chr(13)
   Case Is > 0
      Label2.Caption = Label2.Caption + "Souvenez vous qu'insulter les autres ne permet pas d'avancer. Et risque de vous fermer des portes." + Chr(13)
End Select
'
' analyse des !
'
Select Case infoexcla
   Case Is > 10
      Label2.Caption = Label2.Caption + "Vous aimez vous faire entendre." + Chr(13)
   Case Is > 4
      Label2.Caption = Label2.Caption + "Vous preferez exprimer vos idées clairement." + Chr(13)
End Select
'
' analyse de ?
'
Select Case infointer
   Case Is > 10
      Label2.Caption = Label2.Caption + "Vous vous posez beaucoup de questions." + Chr(13)
   Case Is > 4
      Label2.Caption = Label2.Caption + "Vous restez très indécit sur certaines questions." + Chr(13)
End Select
'
' analyse des je
'
Select Case infoje
   Case Is > 10
      Label2.Caption = Label2.Caption + "Vous savez bien parlé de vous.C'est bien vous acceptez de vous dévoiler." + Chr(13)
   Case Is > 4
      Label2.Caption = Label2.Caption + "Vous avez parlé de vous, mais pas encore assez!" + Chr(13)
   Case Is >= 0
      Label2.Caption = Label2.Caption + "Vous etiez la pour parler de vous et vous avez très peu employé le je!Cela cache un problème de confiance en soi!" + Chr(13)
End Select
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

'
' premiere phase en decoupe la phrase en mot
' maxi 100 mots
Dim resultat(100)
zone = TextBox1.Text
x = 1
nb = 0
zone2 = ""
'
' caracteres qui determine le decoupage
'
cardecoup = " ,;.'!?"
'
' caracteres de type e
'
care = "éèêë"
For g = 1 To Len(zone)
   '
   ' on met en minuscule
   '
   car = LCase(Mid$(zone, g, 1))
   '
   'on comptablilise les ! ?
   '
   Select Case car
      Case "!"
         infoexcla = infoexcla + 1
      Case "?"
         infointer = infointer + 1
   End Select
   '
   ' on elimine les accents
   '
   If InStr(care, car) Then
      car = "e"
   End If
   '
   ' on change de mot ?
   '
   If InStr(cardecoup, car) > 0 Then
      If zone2 <> "" And nb <= 100 Then
         nb = nb + 1
         resultat(nb) = zone2
      End If
      zone2 = ""
   Else
      zone2 = zone2 + car
   End If
Next g
'
' on cumule le nombre de mots
'
totalmots = totalmots + nb
'
' ne pas oublier le dernier mot
'
If zone2 <> "" And nb <= 100 Then
   nb = nb + 1
   resultat(nb) = zone2
End If
'
' on remplace elle et il par (mere,pere,...)
'
For g = 1 To nb
   If "elle" = resultat(g) Then resultat(g) = elle
   If "il" = resultat(g) Then resultat(g) = il
Next g
'
' ok on fait l'analyse de la phrase
'
reponse = ""
insulte = "/con/connard/idiot/stupide/"
For g = 1 To nb
   '
   ' insulte ?
   '
   If InStr(insulte, "/" + resultat(g) + "/") > 0 Then
      reponse = "Ne vous enervez pas !!! Evitez d'employé le mot " + resultat(g) + ", cela n'arrange rien..."
      infoinsulte = infoinsulte + 1
   End If
   '
   ' relation avec l'argent
   '
   Select Case resultat(g)
      Case "je"
         infoje = infoje + 1
      Case "argent"
         choix = Int(Rnd * 10 + 1)
         Select Case choix
            Case 1
               reponse = "Vous pensez que l'argent pose des problèmes?"
            Case 2
               reponse = "Au faites mon tarif est de 1 500 francs la séance!" + Chr(13) + "je plaisante..."
            Case 3
               reponse = "Et les autres membres de la famille peuvent vous aider à régler ces problèmes d'argent?"
            Case 4
               reponse = "Le fait que l'argent"
               For h = g + 1 To nb
                  reponse = reponse + " " + resultat(h)
               Next h
               reponse = reponse + ", cela vous empeche de prendre du recul par rapport à lui!"
            Case 5
               reponse = "D'accord l'argent peut provoquer effectivement ceci. Mais ne vous focalisez pas trop sur lui."
            Case 6
               reponse = "L'argent pour vous est sans doute très important?"
            Case 7
               reponse = "Le manque d'argent vous poursuit-il ?"
            Case 8
               reponse = "L'argent doit être un moyen pas une finalité!"
            Case 9
               reponse = "Cela vous bloque-t-il dans vos projets?"
            Case 10
               reponse = "Vous sentez vous seul face à ce probleme?"
         End Select
         infoargent = infoargent + 1
         g = nb
      '
      ' relation avec le travail
      '
      Case "travail"
         If infotravail = 5 Then
            reponse = "Je vois que votre travail est un élément important de votre vie."
          Else
            choix = Int(Rnd * 10 + 1)
            Select Case choix
               Case 1
                  reponse = "Si votre travail"
                  For h = g + 1 To nb
                     If resultat(h) = "me" Then
                        reponse = reponse + " vous"
                      Else
                         reponse = reponse + " " + resultat(h)
                      End If
                  Next h
                  reponse = reponse + ", vous en souffez?"
               Case 2
                  reponse = "Le problème vient de vous ou de vos collègues?"
               Case 3
                  reponse = "Souvent cela cache un manque d'assurance dans le travail!"
               Case 4
                  reponse = "Bien, mais vous pensez que cela est du uniquement aux autres?"
               Case 5
                  reponse = "Attention le monde du travail n'est pas le monde familial! Il ne faut pas mélanger les genres."
               Case 6
                  reponse = "C'est un choix ce type de metier?"
               Case 7
                  reponse = "Cela provoque-t-il des répercussions dans votre vie familiale?"
               Case 8
                  reponse = "Le fait que " + resultat(g - 1) + " " + resultat(g) + " " + resultat(g + 1) + " " + resultat(g + 2) + ", provoque quoi comme problème?"
               Case 9
                  reponse = "Le travail est souvent source de conflit!"
               Case 10
                  reponse = "Le travail doit aussi participer à votre epanouissement."
            End Select
         End If
         infotravail = infotravail + 1
         g = nb
      '
      ' relation avec le pere
      '
      Case "pere"
         If infopere = 5 Then
            reponse = "Je vois que votre père est une piece importante de votre vie."
          Else
            choix = Int(Rnd * 10 + 1)
            Select Case choix
               Case 1
                  reponse = "Si votre père"
                  For h = g + 1 To nb
                     If resultat(h) = "me" Then
                        reponse = reponse + " vous"
                      Else
                         reponse = reponse + " " + resultat(h)
                      End If
                  Next h
                  reponse = reponse + ", vous en souffez?"
              Case 2
                 reponse = "Cette relation avec votre père, vous fait-elle encore souffrir?"
              Case 3
                 reponse = "Pensez-vous que votre père en a eu conscience?"
              Case 4
                 reponse = "Oui, je comprends mais votre père était-il responsable de cela?"
              Case 5
                 reponse = "Dans ce cas, votre père vous embetait?"
              Case 6
                 reponse = "Cela produisait-il de la gène par rapport aux autres ?"
              Case 7
                 reponse = "Votre père comprenait-il réellement toutes les implications?"
              Case 8
                 reponse = "Votre père " + resultat(g + 1) + " " + resultat(g + 2) + ", dites-vous. Cela a entrainé quels problèmes?"
              Case 9
                 reponse = "En avait-il toute la responsabilité?"
              Case 10
                 reponse = "Et vous même, pensez-vous reproduire le même schéma?"
            End Select
         End If
         infopere = infopere + 1
         g = nb
         il = "pere"
      '
      ' relation avec la mere
      '
      Case "mere"
         If infomere = 5 Then
            reponse = "Je vois que votre mère est une piece importante de votre vie."
         Else
            choix = Int(Rnd * 10 + 1)
            Select Case choix
               Case 1
                  reponse = "Si votre mère"
                  For h = g + 1 To nb
                     If resultat(h) = "me" Then
                        reponse = reponse + " vous"
                     Else
                        reponse = reponse + " " + resultat(h)
                     End If
                  Next h
                  reponse = reponse + ", cela reste un vrai problème encore aujourd'hui?"
               Case 2
                  reponse = "Et vous vous considerez cela comme un faute de votre mere?"
               Case 3
                  reponse = "Votre mere connaissait elle de grave difficulté?"
               Case 4
                  reponse = "Il faut réussir à vous détacher de tel souffrance avec votre mère!"
               Case 5
                  reponse = "Votre mere"
                  If g < nb Then
                     For h = g + 1 To nb
                         If resultat(h) = "me" Then
                            reponse = reponse + " vous"
                         Else
                            reponse = reponse + " " + resultat(h)
                         End If
                     Next h
                     reponse = reponse + " et en cela vous etes tres sensible?"
                  Else
                  End If
               Case 6
                  reponse = "Et votre pere qu'en disait-il ?"
               Case 7
                  reponse = "Votre famille connaissait-elle ce coté de votre mère?"
               Case 8
                  reponse = "Il faut savoir pardonné, surtout à sa mère!"
               Case 9
                  reponse = "Je sens bien, que cette relation entre vous et votre mère vous hante."
               Case 10
                  reponse = "Les relations avec sa mère sont souvent difficile à expliquer!"
            End Select
         End If
         infomere = infomere + 1
         g = nb
         elle = "mere"
      '
      ' verbe etre
      '
      Case "suis"
         reponse = "Pourquoi etes-vous"
         For h = g + 1 To nb
            reponse = reponse + " " + resultat(h)
         Next h
         g = nb
         reponse = reponse + "?"
      Case "etes"
         If infovous = True Then
            reponse = "Je vous l'ai dejà dit, c'est de vous qu'il faut parler!"
         Else
            reponse = "Je suis peut etre"
            For h = g + 1 To nb
               reponse = reponse + " " + resultat(h)
            Next h
            reponse = reponse + ", mais c'est de vous qu'il sagit!"
            infovous = True
         End If
         g = nb
    End Select
Next g
If reponse = "" Then
   If nb = 0 Then
      reponse = "Dites moi quelque chose..."
   Else
   '
   ' on a rien trouve on lance une phrase au hasard
   '
      choix = Int(Rnd * 20 + 1)
      Select Case choix
         Case 1
            reponse = "Oui, je comprend bien" + Chr(13) + "Mais donnez moi plus d'explication."
         Case 2
            reponse = "C'est interressant continuez!"
         Case 3
            reponse = "Vraimment " + resultat(Int(Rnd * nb + 1)) + " est-il le terme exact?"
         Case 4
            reponse = "Souvent on croit que"
            For g = 1 To nb
               reponse = reponse + " " + resultat(g)
            Next g
         Case 5
            reponse = "Ne vous fiez pas aux apparences."
         Case 6
            reponse = "Vous pouvez m'expliquer le terme " + resultat(nb) + ", que vous avez employé?"
         Case 7
            reponse = "Vous savez, la vie n'est pas toujours evidente!"
         Case 8
            reponse = "Cela a-t-il un rapport avec votre mere ?"
         Case 9
            reponse = "Cela a-t-il un rapport avec votre pere ?"
         Case 10
            reponse = "Je pense que vous avez raison!"
         Case 11
            reponse = "J'ai bien compris " + resultat(nb) + ", mais pouvez-vous mieux décrire le problème."
         Case 12
            reponse = "Si je vous repose les mêmes questions, c'est pour être sur de vos réponses..."
         Case 13
            reponse = "Continuez, vous progressez!"
         Case 14
            reponse = "Il n'y a pas que " + resultat(1) + " " + resultat(2) + ", dans la vie!Essayez de me parler d'autre chose."
         Case 15
            reponse = "Vous etes là pour vous exprimer!"
         Case 16
            reponse = "D'accord, mais cela fait-il partie d'une souffrance?"
         Case 17
            reponse = "Pour vous la vie est-elle un long fleuve tranquille?"
         Case 18
            reponse = "Bien , voilà une information !Continuez!"
         Case 19
            reponse = "D'accord, c'est clair.Mais maintenant parlez moi de vos relations avec une autre personne!"
         Case 20
            reponse = "Ok, j'ai bien compris!Mais donnez moi plus d'informations sur le sujet!"
      End Select
   End If
End If
Label2.Caption = reponse
End Sub

Private Sub UserForm_Activate()
'
' on met en place les variables
'
infovous = False
infopere = 0
infomere = 0
infoargent = 0
totalmots = 0
infoexcla = 0
infointer = 0
infoinsulte = 0
infotravail = 0
infoje = 0
elle = "elle"
il = "il"
End Sub

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
jeudi 27 novembre 2008
Statut
Membre
Dernière intervention
16 février 2009

pareil, j'aimerais pouvoir tester ce prog, ça me rappelera mes premiers pas sur l'ordinateur, ou bien si vous savez comment je pourrais en trouver facilement sur d'autres sites ou par google, je ne sais pas trop quoi taper !!

D'avance, merci.
Utilisateur anonyme
le lien pour telecharger l'exe est mort! vous en auriez pas un autre? merci
Messages postés
79
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
28 août 2010

ddev a raison g pas envi de me faire chier a chercher l'ereure
Messages postés
4
Date d'inscription
dimanche 28 avril 2002
Statut
Membre
Dernière intervention
30 juillet 2005

Bonjour,

qq1 aurait-il le programme compilé ?

Merci.
Messages postés
193
Date d'inscription
jeudi 14 février 2002
Statut
Membre
Dernière intervention
25 mars 2011
1
c'est normal qu'il ne marche, fo pas taper sur l'ecran ni engueuler VB !! ;-)

Le code a été fait sous excel donc en VBA. Il faut mettre une userform, un bouton, deux labels (dont une assez large).
vous copiez le tout et voila ca roule !!

c'est marrant, on croirait presque pendant qq secondes que l'on parle a qqun...lol


Metalcoder
Afficher les 29 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.