explication sur l'object scriptcontrol

Invité · 06/07/2015, 17h39

Bonjour Patrick,
J'ai créé ma propre librairie ScriptControl, en Vb.net pour te permettre de plus ou moins comprendre le code, et ça marche en multithread (Framework 3.0) via Excel. Vba!

Je dois faire des tests sur d'autres machines, car sur celle de dev forcément, ainsi je pourrais évoluer le prérequis et je reviens vers toi pour te donner la procédure!

Il me restera à gérer un événement pour récupérer le résulta du run car il ne peut en être autre. Car multithread implique un traitement différé.

Comme tu la précisé plus haut, tu regarde quel Framework tu retrouve sur tous tes pc et je recompilerai en fonction!

**patricktoulon** · 06/07/2015, 19h03

bonjour durupt
oui la stratégie serait peut être aussi pourquoi pas de lire le registre pour savoir quelle version utiliser sa se fait en rien du tout ca non?

avec un message si utilisation impossible
je fait souvent comme ca moi pour mes addins office32 software;office 64 syswow /software

je vais peut etre m'y mettre au ".net"

Invité · 06/07/2015, 23h03

Ce qui importe en réalité c'est la version du Framework, car en réalité tu n'as pas besoin de registrer la dll!

Tu la place dans un répertoire genre c:\myrep\mylibrairie.ltb (c'est le type d'extension accepté par vba). Visual studio acceptera dans ses directives de compilation 32 bits; 64 ou mixte.

Vue que le chemin de la dll est inscrit dans ton projet VB, le veersionning ne pose plus de problème, tu copy chez le client le répertoire au bon endroit et le tour est joué!

Au pire tu télécharge et installe le bon Framework.

**patricktoulon** · 07/07/2015, 09h52

re
bonjour Durupt

mode1 :la dll dans un dossier
cela implique un transport joint pour la transportabilité

mode 2: réinstaller la bonne version
pour ma part j'ai des Apps qui fonctionnent seulement a partir de la 4.0 en dessous elles plantent

mais après tout comme elles sont toutes la: en dur dans le projet le chemin existant je suppose que cela est identique pour tout le monde non? tout du moins pour chaque system d'exploitation

Invité · 09/07/2015, 09h07

Bonjour Patrick,

Voilà une première version j'ai utilisé le Framework 4.0!

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
Sub test()
Dim a As Integer
Dim Code As String
Code = "Function Test()" & vbCrLf
Code = Code & "dim a,i" & vbCrLf
Code = Code & "for i = 1 to 10" & vbCrLf
Code = Code & "a = a + 10" & vbCrLf
Code = Code & "next " & vbCrLf
Code = Code & "   Test = a" & vbCrLf
Code = Code & "End Function" & vbCrLf
Dim scr(10) As New Classe1
Dim I As Integer
For I = 0 To 10
    scr(I).Language = "VbScript"
    scr(I).AddObject "This", ThisWorkbook
    scr(I).ModulesAdd "Module1"
    scr(I).AddCode Code
    scr(I).Run "test"
    DoEvents
Next
End Sub

Code Module de classe :

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
 
'Private WithEvents scr As ScriptControlRD.ScriptControlRD
Private  scr As ScriptControlRD.ScriptControlRD
 
Public Property Let Language(Value As String)
scr.Language = Value
End Property
Public Property Get Language() As String
Language = scr.Language
End Property
Public Sub AddCode(Code)
 scr.AddCode Code
 End Sub
Public Sub AddObject(Virtuel As String, Phisique As Object)
  scr.AddObject "This", ThisWorkbook
  End Sub
 Public Sub ModulesAdd(Modul As String)
 scr.ModulesAdd Modul
 End Sub
 Public Sub Run(Optional ByVal Metthode As String = "")
 scr.Run Metthode
 End Sub
 
Private Sub Class_Initialize()
Set scr = New ScriptControlRD.ScriptControlRD
End Sub
 
Private Sub Class_Terminate()
Set scr = Nothing
End Sub

Code VB.Net :

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Imports System.Data
Imports System.Runtime.InteropServices
Imports System.Threading.Thread
Imports System.Threading
Imports System.EventArgs
 
Public Class ScriptControlRD
    Inherits System.EventArgs
    'Cette partie là permet de décharger l’instance de la classe (Set Nothing), redonne au Framework (Dispose)
    Implements IDisposable
    Dim disposed As Boolean = False
 
    Delegate Sub AfterAddCode()
    Event _AfterAddCode As AfterAddCode
 
    Delegate Sub AfterRun(ByVal Rseult As Object)
    Event _AfterRun As AfterRun
 
 
 
 
    Public Overloads Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
    Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
        If disposed = False Then
            If disposing Then
                disposed = True
            End If
        End If
    End Sub
    Protected Overrides Sub Finalize()
        Dispose(False)
    End Sub
    'Fin Dispose!
    Private scr As Object = Nothing
    Private _Language As String
    Private _Code As String
    Private _Metthode As String
 
    Public Property Language As String
        Get
            Return _Language
        End Get
        Set(value As String)
            _Language = value
            scr.Language = value
        End Set
    End Property
 
 
 
 
    Public Sub New()
        scr = CreateObject("ScriptControl") 'On affect un référence à un objet sens (Set)    
    End Sub
    Public Sub Run(Optional ByVal Metthode As String = "")
        _Metthode = Metthode
        Dim t As New Thread(AddressOf RunThreadProc)
        t.Start()
    End Sub
 
    Private Sub AddCodeThreadProc()
        scr.AddCode(_Code) : RaiseEvent _AfterAddCode()
    End Sub
    Private Sub RunThreadProc()
        Dim Result As Object = Nothing
        If _Metthode.Trim.ToString <> "" Then
            Try
 
            Catch ex As Exception
                Return
            End Try
            Result = scr.run(_Metthode)
 
            RaiseEvent _AfterRun(Result)
 
        End If
 
    End Sub
    Public Sub AddObject(Virtuel As String, Phisique As Object)
        scr.AddObject(Virtuel, Phisique, True)
    End Sub
    Public Sub ModulesAdd(Modul As String)
        scr.Modules.Add(Modul)
    End Sub
 
    Public Sub AddCode(Code)
        _Code = Code
        Dim t As New Thread(AddressOf AddCodeThreadProc)
        t.Start()
    End Sub
    'En .net, la méthode CeateObject n’existe pas il faut l’implémenter !   
    Private Function CreateObject(ByVal app As String) As Object
        Dim AppType As Object = Type.GetTypeFromProgID(app)
        Dim ApplInst As Object = Activator.CreateInstance(AppType)
        Return ApplInst
    End Function
 
End Class

**patricktoulon** · 09/07/2015, 13h25

Bonjour Durupt je viens de l'essayer et j'ai le message d'erreur activX

je vais vérifier si j'ai bien la 4.0
Nom : Capture.JPG
Affichages : 299
Taille : 110,5 Ko

Nom : Capture.JPG
Affichages : 299
Taille : 110,5 Ko

faut il enregistrer la dll ou en l'ajoutant dans les références comme dans tes captures d'écran suffit?

Invité · 09/07/2015, 13h30

Oui, je n'est pas trouvé!
sur 4 machine disposant du Framework 4.0 ça ne marche que sur 3!

1 Win8 (64) ; 1 Xp (64) ; win7 (x86); non sur in win7 (64)???????

je cherche, mais j'espérait qu'un au mois chez toi fonctionne pour avoir déjà un appréciation.

je te rassure je ne jette pas l'éponge!

**patricktoulon** · 09/07/2015, 13h37

bon déjà pour moi c'est la version 4.1 et 4.5 active
comme tout bon windowsien j'ai laisser cette version pourri s'installer
je ne sais pas comment ca c'est produit car j'ai bloqué Wupdate a cause justement de la saloperie de netframework optimization keygen ...... qui fout le boxon
je me suis fait avoir
alors maintenant pour la désinstaller galère purée réimage system c'est le seul moyen de la viré selon msdn
je vais quand même essayé de réinstaller une surcouche avec la 4.0 on verra bien
Nom : Capture.JPG
Affichages : 274
Taille : 106,7 Ko

Nom : Capture.JPG
Affichages : 274
Taille : 106,7 Ko

Invité · 09/07/2015, 13h49

Pour la question de la gestion des événements (ar il faut bien attendre la fin du script d'une dure???) 'ai posé la question sur le forum vb.net, mais les étoiles sur mes épaulettes en effraient plus d'un!

**patricktoulon** · 09/07/2015, 14h25

c'est jolie pourtant les Etoiles

Bon après suppression de de la V4.5.1 et réinstallation de la V4 et extented

j'ai toujours le même message

alors j'ai quand meme pris le temps d'examiner le code

alors 1
ta subtest envoie des appel au fonction de la classe
et bien quand tu envoie des arguments sert toi en non?
exemple ici
dans la sub test

Code :

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

1
2
3
4
5
6
7
8
For I = 0 To 10
scr(I).Language = "VbScript"
scr(I).AddObject "This", ThisWorkbook
scr(I).ModulesAdd "Module1"
scr(I).AddCode Code
scr(I).Run "test"
DoEvents
Next

dans la fonction pour la ligne rouge dans la classe tu aurais du mettre ceci:
[CODE][Public Sub AddObject(Virtuel As String, Phisique As Object)
scr.AddObject virtuel, phisique
End Sub/CODE]

ensuite pour la variable tableau object et variable simple object utilisant le même nom je ne suis pas sur qu'il n'y ait pas conflit
"src" l'object simple qui est un scriptcontrolRD
et le scr(X) qui est une classe

d'autant plus que tu paramètre le langage sur la variable tableau "src(X)" et tu ajoute le code dans l'object simple "src"

a fin de ne pas avoir d'ambiguïté a la place des propertie let/get
j'aurais fait des fonctions

j'analyse encore ca et je reviens

**patricktoulon** · 09/07/2015, 14h37

Ensuite

ici

Code :

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

Dim scr(10) As New Classe1

tu instancie que la 10 a mon avis non?

j'aurais fait comme ceci

Code :

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

dim src(10) as object

a l'intérieur de la boucle

Code :

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

set src(X) = new classe1

ou au même endroit

Code :

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

redim src(1 to 10) as new classe1

mais bon des fois je me plante avec ca alors je n'en suis pas sur

on sais jamais des fois qu'une Etoile me tombe sur la tête

Invité · 09/07/2015, 14h38

tu aurais du mettre ceci:
[CODE][Public Sub AddObject(Virtuel As String, Phisique As Object)
scr.AddObject virtuel, phisique
End Sub/CODE]

oui copier coller intempestif de l'ancien code Vba.

je ne suis pas sur qu'il n'y ait pas conflit
"src" l'object simple qui est un scriptcontrolRD
et le scr(X) qui est une classe

dans tous les endroits ou il existe il est private!

**patricktoulon** · 09/07/2015, 14h49

e allez encore excuse moi quand même d'avance hein!!!

ici

Code :

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

1
2
3
4
5
6
7
Private scr As ScriptControlRD.ScriptControlRD
Public Property Let Language(Value As String)
scr(I).Language = Value
End Property
Public Property Get Language() As String
Language = scr(I).Language
End Property

en aucun cas!!! dans la classe ou dans la sub test l'object simple "src" qui est le control reçoit son langage ,c'est quand même lui qui exécute le "code" non??
ou bien encore ici pareil r

Code :

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

1
2
3
4
5
6
7
8
9
Public Sub AddObject(Virtuel As String, Phisique As Object)
  scr.AddObject "This", ThisWorkbook 'ICI TU AJOUTE A L OBJECT SIMPLE
  End Sub
 Public Sub ModulesAdd(Modul As String)
 scr(I).ModulesAdd Modul 'ICI TU AJOUTE A L INTANCE DE LA CLASSE
 End Sub
 Public Sub Run(Optional ByVal Metthode As String = "")
 scr.Run Metthode
 End Sub

DONC POUR MOI TU RUN UN scriptcontrolRD sans paramètre langage et sans module

Invité · 09/07/2015, 14h57

Je ne suis pas devant mon ordinateur,mais je pensais bien. Avoir mis

Code :

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

1
2
3
4
5
Private  scr As ScriptControlRD.ScriptControlRD
 
Public Property Let Language(Value As String)
scr.Language = Value
End Property

**patricktoulon** · 09/07/2015, 14h59

et non!!!tu n'avais pas bien mis
il n'y a pas que la regarde mon dernier post

tu va me maudire!!!

Invité · 09/07/2015, 15h13

Rendez vous dans les faussés de Vinciennes

**patricktoulon** · 09/07/2015, 15h54

nan!!!! faut pas se décourager si vite

en tout cas je l'ai repris comme ceci:

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
Sub test()
Dim a As Integer
Dim Code As String
Code = "Function Test()" & vbCrLf
Code = Code & "dim a,i" & vbCrLf
Code = Code & "for i = 1 to 10" & vbCrLf
Code = Code & "a = a + 10" & vbCrLf
Code = Code & "next " & vbCrLf
Code = Code & "   Test = a" & vbCrLf
Code = Code & "End Function" & vbCrLf
Dim scr(10) As New Classe1
Dim I As Integer
For I = 0 To 10
scr(I).language "VbScript"
scr(I).AddObject "This", ThisWorkbook
scr(I).ModulesAdd "Module1"
scr(I).AddCode Code
scr(I).Run "test"
DoEvents
Next
End Sub

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
Private scr As ScriptControlRD.ScriptControlRD
Private Sub Class_Initialize()
Set scr = New ScriptControlRD.ScriptControlRD
End Sub
Public Sub language(langu As String)
 scr.language = langu
End Sub
Public Sub AddObject(Virtuel As String, Phisique As Object)
  scr.AddObject Virtuel, Phisique
  End Sub
 Public Sub ModulesAdd(Modul As String)
 scr.ModulesAdd Modul
 End Sub
Public Sub AddCode(Code)
 scr.AddCode Code
 End Sub
 
 Public Sub Run(Optional ByVal Metthode As String = "")
 scr.Run Metthode
 End Sub
Private Sub Class_Terminate()
Set scr = Nothing
End Sub

et j'ai toujours le message "ne peut pas créer d'object"

Invité · 09/07/2015, 19h40

Je vais installer une autre VM et je ferais des test dessus!

Ça marche sur 3/4, j'ai loupé qq chos!

**patricktoulon** · 10/07/2015, 10h55

re
Bonjour Durupt
ok mais ca me parait assez aléatoire avec cette histoire de version

dis moi si je télécharge la version essaie vb2010 je pourrais voir un peut le reste du projet dans ta dernière pièce jointe ou pas ???

seconde question
pour vba seule la dll et le tlb sont nécessaire non?