création d'une fonction ou procédure dynamiquement

**benzoid555** · 13/05/2009, 14h32

bonjour je cherche a crée une fonction dynamiquement :

je m'explique

j'ai un tableau avec des formules
mon_tableau = array("a+b","a-b","a*b")

J'aimerai creer dynamique une fonction qui execute la formule choisit
en truc du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub createur_de_function(n As interger)
 
'on dimensionne
dim my_function as function
 
'on recupère la formule
formule = mon_tableau(n)
 
'on ecrit le code de la fonction
code = "Private Sub my_function" & vbNewLine
code = code & "resultat = " & formule & vbNewLine
code = code & "msgbox =" & formule & "=" & resultat & vbNewLine
code = code & "End sub"
 
'affectation du code à la fonction
Set my_function.code = code
 
End Sub

avez vous une idée ?

**ilank** · 13/05/2009, 14h53

Bonjour,

si effectivement tes formules sont du type a+b, a-b ....
utilise la fonction Eval().

Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

msgbox mon_tableau(n) & " = " & Eval(mon_tableau(n))

**benzoid555** · 13/05/2009, 16h30

Merci ilank pour ta reponse
mais la fonction eval() n'existe pas avec excel 2007

j'ai essayer avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
MsgBox mon_tableau(n) & " = " & Application.Evaluate(mon_tableau(n))

mais il me repond incompatiblité de type

d'après http://silkyroad.developpez.com/VBA/...sicEditor/#LIV

je pense faire quelque chose comme ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub creationModule()
    'Nécéssite d'activer la référence
    '"Visual basic For Application Extensibility 5.3"
    '
    Dim Wb As Workbook
    Dim VBComp As VBComponent
    Dim X As Integer
 
    'Définit le classeur cible
    Set Wb = Workbooks("Classeur1.xls")
 
    'Ajoute un module standard dans le classeur
    Set VBComp = Wb.VBProject.VBComponents.Add(1)
    'Renomme le module
    VBComp.Name = "NouveauModule"
 
    'Ajoute une macro dans le module
    With VBComp.CodeModule
        X = .CountOfLines
        .InsertLines X + 1, "Sub laMacro()"
        .InsertLines X + 2, "Range(""A1"").Value = ""Coucou"""
        .InsertLines X + 3, "End Sub"
    End With
End Sub

ps : j'ai bien activé "Visual basic For Application Extensibility 5.3"
et l'option "Accès approuvé au modèle d'objet du projet VBA " dans le Centre de gestion de la confidentialité, sur Paramètres du Centre de gestion de la confidentialité, puis sur Paramètres des macros

**ilank** · 13/05/2009, 17h13

Oui, effectivement Eval() c'est dans Access, désolé.

pour la création d'un nouveau module, remplace cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set VBComp = Wb.VBProject.VBComponents.Add(1)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set VBComp = Application.VBE.ActiveVBProject.VBComponents.Add(1)

sinon essaie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Function Resultat (n as integer)
Dim i as integer, operateur as byte, Num1, Num2
 Resultat=0
 i=i+1
 do While i<len(mon_tableau(n))
   Select Case Mid(mon_tableau(n),i,1)
     Case "+","-","*","/"
          Operateur=asc(mid(mon_tableau(n),i,1))
          num1=Replace(left(mon_tableau(n),i-1),".",",")
          num2=Replace(mid(mon_tableau(n),i+1),".",",")
          exit do
   End select
   i=i+1
 Loop
 Select case Operateur
  Case 42 '*
   Resultat=Num1*Num2
  Case 43 '+ 
    Resultat=Num1+Num2
  Case 45 '-
    Resultat=Num1-Num2
  Case 47 '/
     If Num2<>0 then Resultat=Num1/Num2
 End Select
End Function

**LeForestier** · 13/05/2009, 17h33

Bonjour,
Je ne pensais pas que tu voulais ajouter un module, mais ça peu te donner une idée..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Creer3Func()
Dim mon_tableau, i As Integer
    mon_tableau = Array("a+b", "a-b", "a*b")
    Sheets("feuil1").Activate
    i = 1
    CréeFonction "Ma_Fonction" & i, CStr(mon_tableau(i))
End Sub
 
Private Sub CréeFonction(Nom As String, Formule As String)
Dim Code As String
    Code = "Private Function " & Nom & "(A , B)" & vbNewLine
Code = Code & vbTab & Nom & " = " & " A " & Mid(Formule, 2, 1) & " B" & vbNewLine
Code = Code & vbTab & "msgbox " & """" & Formule & " = " & """" & "& A " & Mid(Formule, 2, 1) & " B" & vbNewLine
Code = Code & "End sub"
 
'Ajoute la macro dans le module spécifié.
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
End Sub

J'ai tester et ça met bien une fonction dans le code de la Feuil1.
J'ai essayer de créer les 3 d'un coup avec une boucle mais à chaque fois excel se plante et je n'ai pas trouvé de parade.
Tu peu toujours ajouter le module avant.
A+
Edit :
Résultat =

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Function Ma_Fonction1(A, B)
    Ma_Fonction1 = A - B
    MsgBox "a-b = " & A - B
End Sub

Je viens de voir ton post précédant,
ATTENTION. si tu met un nouveau classeur, par exemple Classeur1
et que tu veux mettre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Définit le classeur cible
    Set Wb = Workbooks("Classeur1.xls")

Ca va planter, tant que le classeur n'a pas été sauver son nom c'est Classeur1 et Pas Classeur1.xls

**benzoid555** · 15/05/2009, 11h06

Ce que je voulais faire ne fonctionne pas.
Visual_basic permet de modifier la fonction, mais je ne peux pas lancer la nouvelle fonction creer.

Le programme prgm ci dessous s'execute jusqu'a la MsgBox "je vais planter", puis excel se ferme tout seul.

je pense qu'excel perd ses crayons car la nouvelle function n'a pas été complilé avant le lancement du programme, qu'en pensé vous ?

dans un module : "module_temporaire"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Public Function Calcul()
 
End Function

Dans un module de class "Classe1"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
Public a As Long 'copie locale
Public b As Long 'copie locale
Public Property Let ecrire_A(valeur As Long)
     a = valeur
End Property
Public Property Get lire_A() As Long
     lire_A = a
End Property
Public Property Let ecrire_B(valeur As Long)
     b = valeur
End Property
Public Property Get lire_B() As Long
     lire_B = b
End Property
 
Public Sub creer_code(N)
 
    code = "Public Function Calcul()" & vbNewLine
    code = code & vbTab & "A=" & CallByName(Me, "lire_A", VbGet) & vbNewLine
    code = code & vbTab & "B=" & CallByName(Me, "lire_B", VbGet) & vbNewLine
    code = code & vbTab & "Calcul =" & tableau(N) & vbNewLine
 
    code = code & "end function" & vbNewLine
    MsgBox code
 
    Me.ecrire_Module_temporaire (code)
 
 
End Sub
 
 
 
Public Sub ecrire_Module_temporaire(code)
 
    'Nécéssite d'activer la référence
    '"Visual basic For Application Extensibility 5.3"
    '
    Dim Wb As Workbook
    Dim VBComp As VBComponent
    Dim X As Integer
    Dim module_temporaire_existe As Boolean
 
 
    module_temporaire_existe = False
 
    'si le "module_temporaire existe on le vide
    For i = 1 To Application.VBE.ActiveVBProject.VBComponents.Count
        If Application.VBE.ActiveVBProject.VBComponents(i).Name = "module_temporaire" Then
            module_temporaire_existe = True
            Set VBComp = Application.VBE.ActiveVBProject.VBComponents(i)
 
        End If
    Next
 
    'si il n'existe pas on le crée
    If module_temporaire_existe = False Then
        Set VBComp = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule)
        MsgBox VBComp.Name
        VBComp.Name = "module_temporaire"
    End If
 
    'on supprime les lignes
    With VBComp.CodeModule
        X = .CountOfLines
        .DeleteLines 1, X
    End With
    'on ajoute le code
    With VBComp.CodeModule
        X = .CountOfLines
        .InsertLines X + 1, code
    End With
 
End Sub

dans un module "Module1"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Public Sub prgm()
tableau() = Array("a+b", "a-b", "5+a*a")
'on cree CL de la classe1
Set CL = New Classe1
For i = 1 To 5
    'on demande les valeurs
    N = InputBox("valeur de n : ")
    V_a = InputBox("valeur de A : ")
    V_b = InputBox("valeur de B : ")
 
 
    'on ecrit les valeurs
    CL.a = V_a
    CL.b = V_b
    ' on cree la formule
    CL.creer_code N
    'on execute la formule
    MsgBox "je vais planter"
    valeur = Calcul
    MsgBox "j'ai planté"
    'on informe l'utilisateur
    MsgBox tableau(N) & " = " & valeur
Next
End Sub

**LeForestier** · 15/05/2009, 11h52

Tu aurais pu dire directement que tu voulais créer une classe !!
Et je ne vois pas l'intérêt de créer une classe en mode d'exécution !!
De toute façon, un module de classe doit être recompilé à part de excel (fichier *.cls) (c'est apparenté à une dll privée)

A+
Edit: crée ta classe et ensuite tu t'en sert dans les classeurs que tu veux en la mettant en module public , mais je confond peut-être avec VB6

création d'une fonction ou procédure dynamiquement

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager