Donner une valeur à une variable, pour la réutiliser dans une autre procédure

**jbinder** · 17/04/2015, 10h36

Bonjour,

Je travaille actuellement sur Catia V5 et je bidouille un petit peu les macros.
Catia nous fourni de base une macro permettant d'importer des points contenus dans un fichier excel,
cette macro est codée en vba.
Voici la partie du code qui me poste problème: Je veux dans le main récupérer un choix de l'utilisateur (sheet1 ou sheet2), je veux ensuite que ce choix donne une valeur au string Ws pour pouvoir ensuite le réutiliser dans GetCell et choisir ainsi de travailler avec le sheet qui me plait.
J'ai lu sur des sites que le fait de déclarer la variable au début du module permettait de la conserver tout du long, mon code ne marche cependant pas.
Pourriez vous me donner quelques pistes?
(J'ai mis ci-dessous seulement les parties de code qui posent problème)

Merci d'avance,
Jérémy

Code :

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

Dim Ws As Worksheet

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
'------------------------------------------------------------------------
'Get the active cell
'------------------------------------------------------------------------
Function GetCell(iindex As Integer, column As Integer) As String
    Dim Chain As String
 
 
    Sheets(Ws).Select
    If (column = 1) Then
        Chain = "A" + CStr(iindex)
    ElseIf (column = 2) Then
        Chain = "B" + CStr(iindex)
    ElseIf (column = 3) Then
        Chain = "C" + CStr(iindex)
    End If
    Range(Chain).Select
    GetCell = ActiveCell.Value
End Function

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
'------------------------------------------------------------------------
'Main program
'------------------------------------------------------------------------
Sub Main()
 
    'Get the type of profile to create:
    '   NACA-64A112                 --> 1
    '   NACA-64A512        --> 2
 
    Dim ProfileType As Integer
    TypeFile = GetProfileType
 
 
 
 
    'Dim TypeFile As Integer
    'TypeFile = GetTypeFile
 
    ' V5R12 - Create dedicate openBody for created geometry
    'Get CATIA and already created geometrical set
    Dim PtDoc, HKoerper, F, FS As Object
    Set PtDoc = GetCATIAPartDocument
    Set HKoerper = PtDoc.Part.HybridBodies
    Set F = HKoerper.Item("Flügel")
    Set FS = F.HybridBodies.Item("Flügel_Schnitt_1")
 
    ' Create Open body in Geometrical set
    Set Hbody = FS.HybridBodies.Add()
    Hbody.Name = "Profil_Schnitt_1"
 
    If ProfileType = 1 Then
      Set Ws = Sheets(1)
    ElseIf ProfileType = 2 Then
      Set Ws = Sheets(2)
    End If
 
    CreationPoint
 
 
 
End Sub

**joe.levrai** · 17/04/2015, 10h57

Bonjour,

ta variable Ws est déjà un objet "feuille"

donc ta ligne

Code :

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

1
2
 
 Sheets(Ws).Select

ne peut pas fonctionner, Sheets(x) revient à dire que x = le nom de ta feuille (et pas l'objet en lui même)

il faut faire

Code :

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

1
2
 
Ws.Select

j'ai fermé les yeux sur tout le reste :

- pas besoin de travailler avec des select
- on pouvait passer le classeur Ws en argument de ta fonction
- dans ta méthode, Ws a une portée qui ne dépasse pas ton module. Donc si GetCell n'est pas dans le module où est Main : ça ne marchera pas

**jbinder** · 17/04/2015, 11h28

Merci pour ta réponse!

Le truc c'est que ma procédure main() appelle à la fin la procédure creationpoint() qui elle fait appelle aux fonctions GetCellA, GetCellB et GetCellC qui elles font appellent à la fonction GetCell

Y a-t-il un moyen pour que la procedure main() donne la valeur au string Ws qui est ensuite utilisé par les fonctions??

(Ci-dessous le code complet si besoin)

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
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
'//============================================================================
'// COPYRIGHT DASSAULT SYSTEMES 2001
'//============================================================================
'// Generative Shape Design
'// point, splines, loft generation tool
'//============================================================================
Const Cst_iSTARTCurve    As Integer = 1
Const Cst_iENDCurve      As Integer = 11
Const Cst_iSTARTLoft     As Integer = 2
Const Cst_iENDLoft       As Integer = 22
Const Cst_iSTARTCoord    As Integer = 3
Const Cst_iENDCoord      As Integer = 33
Const Cst_iERRORCool     As Integer = 99
Const Cst_iEND           As Integer = 9999
 
Const Cst_strSTARTCurve    As String = "StartCurve"
Const Cst_strENDCurve      As String = "EndCurve"
Const Cst_strSTARTLoft     As String = "StartLoft"
Const Cst_strENDLoft       As String = "EndLoft"
Const Cst_strSTARTCoord    As String = "StartCoord"
Const Cst_strENDCoord      As String = "EndCoord"
Const Cst_strEND           As String = "End"
Dim Ws As Worksheet
 
 
 
'------------------------------------------------------------------------
'To choose the type of profile (1: NACA-64A112
'2: NACA-64A512
'------------------------------------------------------------------------
Function GetProfileType() As Integer
    Dim strInput As String, strMsg As String
 
    choice = 0
    While (choice < 1 Or choice > 2)
        strMsg = "Type in the kind of entities to create (1 for NACA-64A112, 2 for NACA-64A512):"
        strInput = InputBox(Prompt:=strMsg, _
            Title:="User Info", XPos:=2000, YPos:=2000)
 
        'Validation of the choice
        choice = CInt(strInput)
        If (choice < 1 Or choice > 2) Then
            MsgBox "Invalid value: must be 1 or 2"
        End If
    Wend
    GetProfileType = choice
End Function
 
''------------------------------------------------------------------------
''Get the active cell
''------------------------------------------------------------------------
Function GetCell(iindex As Integer, column As Integer) As String
    Dim Chain As String
 
 
    Ws.Select
    If (column = 1) Then
        Chain = "A" + CStr(iindex)
    ElseIf (column = 2) Then
        Chain = "B" + CStr(iindex)
    ElseIf (column = 3) Then
        Chain = "C" + CStr(iindex)
    End If
    Range(Chain).Select
    GetCell = ActiveCell.Value
End Function
Function GetCellA(iRang As Integer) As String
    GetCellA = GetCell(iRang, 1, Ws)
End Function
Function GetCellB(iRang As Integer) As String
    GetCellB = GetCell(iRang, 2, Ws)
End Function
Function GetCellC(iRang As Integer) As String
    GetCellC = GetCell(iRang, 3, Ws)
End Function
'------------------------------------------------------------------------
'Syntax of the parameter file
'------------------------
'StartCurve                 -> to start the list of points defining the spline
' double  ,  double  ,  double
' double  ,  double  ,  double      -> as many points as necessary to define the spline
'EndCurve                   -> to end the list of points defining the spline
'
'
'Example:
'--------
'StartCurve
' -10.89, 10 , 46.78
'1.56, 4, 6
'EndCurve  -> spline composed of 2 points
'------------------------------------------------------------------------
Sub ChainAnalysis(ByRef iRang As Integer, ByRef X As Double, ByRef Y As Double, ByRef Z As Double, ByRef iValid As Integer)
    Dim Chain As String
    Dim Chain2 As String
    Dim Chain3 As String
 
    Chain = GetCellA(iRang)
 
    Select Case Chain
        Case Cst_strSTARTCurve
            iValid = Cst_iSTARTCurve
        Case Cst_strENDCurve
            iValid = Cst_iENDCurve
        Case Cst_strSTARTLoft
            iValid = Cst_iSTARTLoft
        Case Cst_strENDLoft
            iValid = Cst_iENDLoft
        Case Cst_strSTARTCoord
            iValid = Cst_iSTARTCoord
        Case Cst_strENDCoord
            iValid = Cst_iENDCoord
        Case Cst_strEND
            iValid = Cst_iEND
        Case Else
            iValid = 0
    End Select
    If (iValid <> 0) Then
        Exit Sub
    End If
 
 
 
    'Conversion string -> double
    Chain2 = GetCellB(iRang)
    Chain3 = GetCellC(iRang)
    If ((Len(Chain) > 0) And (Len(Chain2) > 0) And (Len(Chain3) > 0)) Then
        X = CDbl(Chain)
        Y = CDbl(Chain2)
        Z = CDbl(Chain3)
    Else
        iValid = Cst_iERRORCool
        X = 0#
        Y = 0#
        Z = 0#
    End If
End Sub
'------------------------------------------------------------------------
' Get CATIA Application
'------------------------------------------------------------------------
'Remark:
'   When KO, update CATIA registers with:
'                       CNEXT /unregserver
'                       CNEXT /regserver
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Function GetCATIA() As Object
    Set CATIA = GetObject(, "CATIA.Application")
    If CATIA Is Nothing Then
       Set CATIA = CreateObject("CATIA.Application")
       CATIA.Visible = True
    End If
 
    Set GetCATIA = CATIA
End Function
'------------------------------------------------------------------------
' Get CATIADocument
'------------------------------------------------------------------------
Function GetCATIAPartDocument() As Object
    Set CATIA = GetCATIA
 
    Dim MyPartDocument As Object
    Set MyPartDocument = CATIA.ActiveDocument
 
    Set GetCATIAPartDocument = MyPartDocument
End Function
'------------------------------------------------------------------------
' Creates all usable points from the parameter file
'------------------------------------------------------------------------
Sub CreationPoint()
 
    'Get CATIA and already created geometrical set
    Dim PtDoc, HKoerper, F, FS As Object
    Set PtDoc = GetCATIAPartDocument
    Set HKoerper = PtDoc.Part.HybridBodies
    Set F = HKoerper.Item("Flügel")
    Set FS = F.HybridBodies.Item("Flügel_Schnitt_1")
 
 
    ' Get the HybridBody, the profile-origin as reference
    Dim Hbody, P, Ref As Object
    Set Hbody = FS.HybridBodies.Item("Profil_Schnitt_1")
    Set P = FS.HybridShapes.Item("Ursprung_Schnitt_1")
    Set Ref = PtDoc.Part.CreateReferenceFromObject(P)
 
    Dim iLigne As Integer
    Dim iValid As Integer
    Dim X As Double
    Dim Y As Double
    Dim Z As Double
    Dim Point As Object
 
 
    iLigne = 1
    'Analyze file
    While iValid <> Cst_iEND
        'Read a line
        ChainAnalysis iLigne, X, Y, Z, iValid
        iLigne = iLigne + 1
 
        'Not on a startcurve or endcurve -> valid point
        If (iValid = 0) Then
            Set Point = PtDoc.Part.HybridShapeFactory.AddNewPointCoordWithReference(X, Y, Z, Ref)
            Hbody.AppendHybridShape Point
        End If
    Wend
 
    'Model update
    PtDoc.Part.Update
End Sub
 
 
'------------------------------------------------------------------------
'Main program
'------------------------------------------------------------------------
Sub Main()
 
 
    'Get the type of profile to create:
    '   NACA-64A112                 --> 1
    '   NACA-64A512        --> 2
 
    Dim ProfileType As Integer
    TypeFile = GetProfileType
 
 
 
 
    'Dim TypeFile As Integer
    'TypeFile = GetTypeFile
 
    ' V5R12 - Create dedicate openBody for created geometry
    'Get CATIA and already created geometrical set
    Dim PtDoc, HKoerper, F, FS As Object
    Set PtDoc = GetCATIAPartDocument
    Set HKoerper = PtDoc.Part.HybridBodies
    Set F = HKoerper.Item("Flügel")
    Set FS = F.HybridBodies.Item("Flügel_Schnitt_1")
 
    ' Create Open body in Geometrical set
    Set Hbody = FS.HybridBodies.Add()
    Hbody.Name = "Profil_Schnitt_1"
 
    If ProfileType = 1 Then
      Set Ws = Sheets(1)
    ElseIf ProfileType = 2 Then
      Set Ws = Sheets(2)
    End If
 
 
 
    CreationPoint
 
 
 
End Sub

Donner une valeur à une variable, pour la réutiliser dans une autre procédure

Macros et VBA Excel

Discussions similaires

Partager

Partager