Bonjour a tous,
 
J'ai un probleme avec ma macro (je commence juste sur VBA et VBScript) qui me fais tourner en bourrique.
 
Ce que je chercher a faire :
Lorsque sur un assemblage complex je selectionne une branche, je veux que ma macro selectionne TOUS les Products, les compte pour identifier le nombre de fois que la macro doit faire de boucle et a chaque item elle recupere le Life Cyce Status et le rajoute a la Description Instance.
 
But de la Macro :
Faire apparaitre le Life Cycle Status dans les fichiers 3dxlm
 
Ce que j'ai reussi a faire :.
Ma macro selectionne bien tous les Products, compte bien les items ... Mais elle applique le Life Cycle Status du dernier item et l'applique a tous. C'est a dire que si j ai 4 items les 2 premiers en InWork et le 2eme en InCheck et le dernier Draft, dans mon 3dxlm le status qui apparait est Draft.
 
Voici ma macro :
 
Sub CATMain()
    Dim objRootProductDoc As ProductDocument
    Set objRootProductDoc = CATIA.ActiveDocument
     
    Dim mySel As Selection
    Set mySel = CATIA.ActiveDocument.Selection
7:
   
    MsgBox "select just ONE WP Not SE"
    On Error GoTo 7
    MsgBox TypeName(CATIA.ActiveDocument.Selection.Item2(1).Value)
    mySel.Search ("'Assembly Design'.Product,sel" )
     
    Dim myProduct As Product
    Dim objProduct1 As Product
    Dim objProduct2 As Product
    Dim ObjProduct3 As String
     
    Dim i As Integer
    For i = 1 To mySel.Count
         
                Set myProduct = mySel.Item(i).Value
                    MsgBox "i = " & i
                        MsgBox myProduct.PartNumber & " = myProduct "
                Set objProduct1 = myProduct.Parent.Parent.ReferenceProduct
                    MsgBox objProduct1.PartNumber & " = objProduct1 "
                        ObjProduct3 = objProduct1.Parameters.Item("Properties\Life Cycle Status" ).ValueAsString
                            MsgBox ObjProduct3 & " Life Cycle Status"
                If ObjProduct3 <> "" Then
                    LifeCycleStatus = ObjProduct3
                      MsgBox LifeCycleStatus
                        myProduct.PartNumber = myProduct.PartNumber & " - " & LifeCycleStatus
                            MsgBox myProduct.PartNumber
                If myProduct.Products.Count = 0 Then
          End If
        End If
    Next 'i
End Sub
 
 
Un grand MERCI par avance de votre aide, si il est possible d'avoir vos explications sur les erreurs et vos solutions serait un plus pour moi.
 
Tres cordialement,
 
Olivier

Ca y est j ai reussi voici le code final pour les curieux :
 
Sub CATMain()
    Dim objRootProductDoc As ProductDocument
    Set objRootProductDoc = CATIA.ActiveDocument
     
    Dim mySel As Selection
    Set mySel = CATIA.ActiveDocument.Selection
7:
   
    MsgBox "select just ONE WP Not SE"
    'On Error GoTo 7
    MsgBox TypeName(CATIA.ActiveDocument.Selection.Item2(1).Value)
    mySel.Search ("'Assembly Design'.Product,sel" )
     
    Dim myProduct As Product
    Dim objProduct1 As Product
    Dim objProduct2 As Product
    Dim ObjProduct3 As String
     
    Dim i As Integer
    For i = 1 To mySel.Count
         
                Set myProduct = mySel.Item(i).Value
                   ' MsgBox "i = " & i
                        MsgBox myProduct.PartNumber & " = myProduct "
                         
               ' If myProduct.Products.Count = 0 Then
                Set objProduct1 = myProduct.Parent
                   ' MsgBox objProduct1.PartNumber & " = objProduct1 "
                        ObjProduct3 = myProduct.Parameters.Item(myProduct.PartNumber & "\Properties\Life Cycle Status" ).ValueAsString
                            MsgBox ObjProduct3 & " Life Cycle Status"
                 
                If ObjProduct3 <> "" Then
                    LifeCycleStatus = ObjProduct3
                     ' MsgBox LifeCycleStatus
                        myProduct.PartNumber = myProduct.PartNumber & " # " & LifeCycleStatus & " # "
                            'MsgBox myProduct.PartNumber
                 
         ' End If
        End If
    Next 'i
            MsgBox "The modifications are finish but not SAVE "
End Sub
 
Bye