Export propriétés CATIA vers Excel et vice-versa

Bonjour,

je me suis inscrit sur le forum afin de trouver des réponses concernant une problématique que je rencontre actuellement.
Au sein de ma société, nous souhaiterions créer une macro permettant de :
1- Extraire vers Excel les propriétés d'un ensemble de pièce et product
2- Les compléter sous Excel manuellement
3- Réimporter ces propriétés les parts CATIA.

Nous avons trouvé une vidéo sur internet permettant de faire ceci mais le code n'était pas disponible.
Nom de la vidéo sous Youtube : Export CATIA properties to Excel and vice versa
Avez-vous déjà réaliser ce genre de macro ?

En espérant une réponse de votre part.

Cordialement,

Personnellement non, mais il y a quelque personnes ici qui devraient pouvoir t'aider à réaliser une telle macro.
N'hésite pas à lire certain post déjà présent sur le forum, qui pourrait t'apporter quelque éléments de réponses.

Bonjour Charly,

Je n'ai pas cette macro en "stock", mais elle peut être créé.
Il faut pour cela savoir quelles sont les propriétés à exportées : uniquement les propriétés ou également des paramètres (ce qui complique le script, les propriétés ajoutées ou utilisateur sont gérées comme des paramètres).
Avec un petit descriptif des besoins je pourrai créé cette macro à condition que ce ne soit pas trop urgent!

Bonjour,

c'est un mixte des deux que nous devons exporter.
Voici la fenêtre propriété CATIA avec les renseignements à exporter :


Nous avons essayé de créer la macro mais sans résultat, nos connaissance sont encore trop restreinte pour ce genre d'utilisation surtout en liant le logiciel CATIA.
Pour le délai, de toute façon nous continuons à travailler dessus mais si vous obtenez un résultat plus vite que nous nous sommes preneur

Merci de coup de main

Bonjour,

Encore quelques précisions :
-Faut-il extraire les propriétés des documents contenu dans CATProduct actif (ce qui revient à analyser sa structure) ou  plus simplement les documents chargés dans CATIA ?
-Dans le cas de l’analyse du CATProduct, celui-ci peut-il être composé de sous-produit et/ ou de composant ?
-Voulez-vous vraiment exporter et éditer le nom d’instance ?

Ci dessous un exemple de code qui exporte les propriétés des documents en session dans Excel:

Code:

Sub CATMain()

Dim myDocument As Document
Dim myProduct As Product
Dim xl As Object 'Excel.Application
On Error Resume Next
    Set xl = GetObject(, "Excel.Application")
If Err <> o Then
    Set xl = CreateObject("Excel.Application")
    xl.Visible = True
End If
On Error GoTo 0

Set myworkbook = xl.workbooks.Add

Set myworksheet = xl.Sheets.Add
myworksheet.Name = "Export"
myworksheet.Range("A1").Value = "Référence"
myworksheet.Range("B1").Value = "Révision"
myworksheet.Range("C1").Value = "Définition"
myworksheet.Range("D1").Value = "Nomencalture"
myworksheet.Range("E1").Value = "Source"
myworksheet.Range("F1").Value = "Description"

For i = 1 To CATIA.Documents.Count
    Set myDocument = CATIA.Documents.Item(i)
    If TypeName(myDocument) = "PartDocument" Or TypeName(myDocument) = "ProductDocument" Then
        Set myProduct = myDocument.Product
        myworksheet.Range("A" & i+1).Value = myProduct.PartNumber
        myworksheet.Range("B" & i+1).Value = myProduct.Revision
        myworksheet.Range("C" & i+1).Value = myProduct.Definition
        myworksheet.Range("D" & i+1).Value = myProduct.Nomenclature
        myworksheet.Range("E" & i+1).Value = myProduct.Source
        myworksheet.Range("F" & i+1).Value = myProduct.DescriptionRef
        
    End If
Next

End Sub


Bonjour,

Il s'agirait d'exporter les propriétés dans le CATProduct actif oui.
Celui-ci peut être composé de Parts, ss-produits et composants...
Concernant le nom d'instance non pas forcément pour l'instant mais il se peut que dans l'avenir oui donc c'était pour avoir déjà la définition de la ligne de code à rajouter

Charly

@lumpazepfel, il se peut aussi qu'il y ait plusieurs fois la même part dans le product du coup il faudrait qu'elle ne sorte qu'une seule fois !
En fait, notre besoin serait de retranscrire une macro qui ferait ce qu'on peux faire avec l'onglet nomenclature mais en plus de pouvoir la modifier une fois sous excel et la réimplanter dans CATIA...

Bonjour Charly,

Je m'en doutais un peu, je suis donc reparti de ma macro nomenclature ...je pense finir la parti export courant de la semaine prochaine.
Par contre si vous voulez qu'une même Part n'apparaisse qu'une seule fois, vous ne pourrez pas puis modifier les noms des instances (qui eux sont différents).

Pour le ré-import il faudrait que l'un des critères exportés ne soit pas modifié pour pouvoir retrouver le document dans CATIA : quel pourrait être ce critère? Le PartNumber ? Ou alors il faut créer dans Excel une colonne avec le valeur original et une colonne avec la nouvelle valeur.

Bonjour,

On va considérer que le PartNumber reste inchangé bien que je garde en tête la solution d'un nouvelle colonne version original, version modifié si jamais

Bonsoir Charly,

Ci-joint la partie export de la macro que vous pouvez déjà tester.
Pour l’instant le test d’unicité se fait sur le nom d’instance, la même CATPart peut donc être exportée plusieurs fois si le nom d’instance est différent.
Mais ce test d’unicité peut se faire sur la référence si vous souhaitez exporter chaque CATPart qu’une seule fois.

Il faut créer une UserForm nommée UserForm1 qui contient 3 boutons nommés
CommandButtonExport, CommandButtonImport et CommandButtonEnd.



Ci-dessous le code associé à la UserForm :

Code:

Private Sub CommandButtonEnd_Click()
    UserForm1.Hide
    End
End Sub

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber '"Export"
myWorksheet.Range("A1").Value = "Référence"
myWorksheet.Range("B1").Value = "Révision"
myWorksheet.Range("C1").Value = "Définition"
myWorksheet.Range("D1").Value = "Nomencalture"
myWorksheet.Range("E1").Value = "Source"
myWorksheet.Range("F1").Value = "Description"
myWorksheet.Range("G1").Value = "Instance"
myWorksheet.Range("H1").Value = "MATERIAL"
myWorksheet.Range("I1").Value = "STATE"
myWorksheet.Range("J1").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("K1").Value = "OBSERVATIONS"
myWorksheet.Range("L1").Value = "LENGHT"
myWorksheet.Range("M1").Value = "WIDTH"
myWorksheet.Range("N1").Value = "MASS"
line = 2

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
    Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A1:N1").Font.Bold = True
myWorksheet.Columns("A:N").EntireColumn.AutoFit
 

End Sub

Private Sub CommandButtonImport_Click()

    MsgBox "Ce n'est pas encore possible..."
    UserForm1.Hide
    End
End Sub

Il faut également un module principal qui contient le code suivant :

Code:

'**********************************************************************
' Macro d'export des propriétés système et utilisateurs d'un assemblage
' Réimport de ces propriétés après modification dans Excel
' Marc Litzler 11/2017
' CATVBA
' http://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa#7113
'**********************************************************************
Public myProduct As Product
Public myDocument As Document
Public myExcel As Object
Public myWorksheet As worksheet
Public line As Integer 'n° de ligne du tableau Excel

Sub CATMain()

'********************************
' Vérifier si le document actif est un CATProduct

On Error Resume Next
Set myDocument = CATIA.ActiveDocument
If Err.Number <> o Then
    MsgBox "Il n'y a pas de fichier ouvert dans CATIA", vbCritical, "Erreur"
    End
End If
If TypeName(myDocument) <> "ProductDocument" Then
    MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
    End
End If
Set myProduct = myDocument.Product

'********************************
' recherche ou déclare l'application Excel

    Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    Set myExcel = CreateObject("Excel.Application")
    myExcel.Visible = True
End If
On Error GoTo 0

UserForm1.Show
  
End Sub

'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item
' Source : ---Script by Emmett Ross---www.scripting4v5.com
'
Sub WalkDownTree(oInProduct As Product)

   Dim oInstances As Products
   Set oInstances = oInProduct.Products

'-----No instances found then this is CATPart

   If oInstances.Count = 0 Then
        If isInExcel(oInProduct.Name) = False Then
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Exit Sub
   End If
  
'-----Found an instance therefore it is a CATProduct (ou un composant)
' Au besoins on peut différentier ici le composant du CATProduct
        If isInExcel(oInProduct.Name) = False Then
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Dim k As Integer
    For k = 1 To oInstances.Count
        Dim oInst As Product
        Set oInst = oInstances.Item(k)
        oInstances.Item(k).ApplyWorkMode DESIGN_MODE
        Call WalkDownTree(oInst)
     Next

End Sub
'Fonction qui verifie si une instance a déjà été exportée
Function isInExcel(instName)
    isInExcel = False
    For l = 2 To line
     If myWorksheet.Range("G" & l).Value = instName Then
        isInExcel = True
         End If
    Next
End Function

Exemple de l’export d’un CATProduct avec sous Product et composant  :

Bonjour,

j'ai testé ce matin votre macro mais il ne comprends pas la définition de worksheet ?

Bonjour,

Il faut que l'éditeur VBA de Catia reconnaisse les fonction du VBA Excel.
Pour cela cliquer sur "Tools" puis "References" et cocher "Microsoft Excel .. Object Library"

Bonjour,

Ci joint le code qui permet d'exporter et réimporter les propriétés systèmes et utilisateur.
Le renommage de l'instance ne fonctionne pas avec cette méthode mais j'ai posté sur le site une autre macro qui permet ce renommage.
https://catiav5.forumactif.org/t1608-macro-de-renommage-des-instances#7119
Code du module principal:

Code:

'**********************************************************************
' Macro d'export des propriétés système et utilisateurs d'un assemblage
' Réimport de ces propriétés après modification dans Excel
' Marc Litzler 11/2017
' CATVBA
' http://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa#7113
'**********************************************************************
Public myProduct As Product
Public myDocument As Document
Public myExcel As Object
Public myWorksheet As worksheet
Public line As Integer 'n° de ligne du tableau Excel

Sub CATMain()

'********************************
' Vérifier si le document actif est un CATProduct

On Error Resume Next
Set myDocument = CATIA.ActiveDocument
If Err.Number <> o Then
    MsgBox "Il n'y a pas de fichier ouvert dans CATIA", vbCritical, "Erreur"
    End
End If
If TypeName(myDocument) <> "ProductDocument" Then
    MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
    End
End If
Set myProduct = myDocument.Product

'********************************
' recherche ou déclare l'application Excel

    Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    Set myExcel = CreateObject("Excel.Application")
    myExcel.Visible = True
End If
On Error GoTo 0

UserForm1.Show
  
End Sub

'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item
' Source : ---Script by Emmett Ross---www.scripting4v5.com
'
Sub WalkDownTree(oInProduct As Product)

   Dim oInstances As Products
   Set oInstances = oInProduct.Products
   'Récupère le nom du parent si ce n'est pas le produit de tete:
    If oInProduct.Parent.Name <> myProduct.Parent.Name Then
        myParent = oInProduct.Parent.Parent.ReferenceProduct.Parent.Name
    End If
    'Récupère le nom de fichier du parent (pour recherche composant):
    myRefProductName = oInProduct.ReferenceProduct.Parent.Name

'-----No instances found then this is CATPart

   If oInstances.Count = 0 Then
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Exit Sub
   End If
  
'-----Found an instance therefore it is a CATProduct (ou un composant)
' Au besoins on peut différentier ici le composant du CATProduct
    
    If myParent = myRefProductName Then
        ' C'est un composant
    Else
        ' C'est un Catproduct
    'End If
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            myWorksheet.Range("A" & line & ":N" & line).Interior.Color = 15921390
            line = line + 1
        End If
        End If
Dim k As Integer
    For k = 1 To oInstances.Count
        Dim oInst As Product
        Set oInst = oInstances.Item(k)
        oInstances.Item(k).ApplyWorkMode DESIGN_MODE
        Call WalkDownTree(oInst)
     Next

End Sub
'Fonction qui verifie si la valeur a déjà été exportée
Function isInExcel(valueToCheck)
    isInExcel = False
    For l = 2 To line
        'If myWorksheet.Range("G" & l).Value = valueToCheck Then 'unicité de l'instance
        If myWorksheet.Range("A" & l).Value = valueToCheck Then 'unicité du PartNumber
            isInExcel = True
        End If
    Next
End Function


Code de la userform:

Code:

Private Sub CommandButtonEnd_Click()
    UserForm1.Hide
    End
End Sub

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber '"Export"
myWorksheet.Range("A1").Value = "Référence"
myWorksheet.Range("B1").Value = "Révision"
myWorksheet.Range("C1").Value = "Définition"
myWorksheet.Range("D1").Value = "Nomencalture"
myWorksheet.Range("E1").Value = "Source"
myWorksheet.Range("F1").Value = "Description"
myWorksheet.Range("G1").Value = "Instance"
myWorksheet.Range("H1").Value = "MATERIAL"
myWorksheet.Range("I1").Value = "STATE"
myWorksheet.Range("J1").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("K1").Value = "OBSERVATIONS"
myWorksheet.Range("L1").Value = "LENGHT"
myWorksheet.Range("M1").Value = "WIDTH"
myWorksheet.Range("N1").Value = "MASS"
line = 2

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
    Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A1:N1").Font.Bold = True
myWorksheet.Columns("A:N").EntireColumn.AutoFit
    
End Sub

Private Sub CommandButtonImport_Click()
Dim oInProduct As Product
'Vérification de la correspondance du classeur Excel avec le Product
For k = 1 To myExcel.workbooks.Count
Set myWorkbook = myExcel.workbooks.Item(k)
    For i = 1 To myWorkbook.Sheets.Count
        MsgBox myWorkbook.Sheets.Item(i).Name
        If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
            'Set myWorksheet = myExcel.Sheets.Item(i)
            Exit For
        End If
    Next i
    If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
        Set myWorksheet = myWorkbook.Sheets.Item(i)
        Exit For
    End If
Next k
If myWorksheet.Name <> myProduct.PartNumber Then
 End
End If


Dim myImpDocument 'As Document
Dim myPartNumber As String
line = 2
Do
    'On Error Resume Next
    On Error GoTo 0
    myPartNumber = myWorksheet.Range("A" & line).Value
    If myDocument.Product.PartNumber <> myPartNumber Then
        'Set myImpDocument = CATIA.Documents.Item(myPartNumber)
        Set myImpDocument = myDocument.GetItem(myPartNumber)
        Set oInProduct = myImpDocument
    Else
        'Set myImpDocument = myDocument
        Set oInProduct = myDocument.Product
    End If
  
    
    Set myparameters = oInProduct.UserRefProperties
    
    'oInProduct.PartNumber = myWorksheet.Range("O" & line).Value '--> pour modifier le PartNumber
    oInProduct.Revision = myWorksheet.Range("B" & line).Value
    oInProduct.Definition = myWorksheet.Range("C" & line).Value
    oInProduct.Nomenclature = myWorksheet.Range("D" & line).Value
    oInProduct.Source = myWorksheet.Range("E" & line).Value
    oInProduct.DescriptionRef = myWorksheet.Range("F" & line).Value
    'Le renommage des instances ne fonction pas avec cette méthode
    'oInProduct.Name = myWorksheet.Range("G" & line).Value
    On Error Resume Next
    myparameters.Item("MATERIAL").Value = myWorksheet.Range("H" & line).Value
    myparameters.Item("STATE").Value = myWorksheet.Range("I" & line).Value
    myparameters.Item("THICKNESS/DIAMETER").Value = myWorksheet.Range("J" & line).Value
    myparameters.Item("OBSERVATIONS").Value = myWorksheet.Range("K" & line).Value
    myparameters.Item("LENGHT").Value = myWorksheet.Range("L" & line).Value
    myparameters.Item("WIDTH").Value = myWorksheet.Range("M" & line).Value
    myparameters.Item("MASS").Value = myWorksheet.Range("N" & line).Value
    
    line = line + 1
Loop Until myWorksheet.Range("A" & line).Value = ""
       
    
    UserForm1.Hide
    MsgBox "Import terminé"
    End
End Sub

L'import peut se faire directement après avoir modifié le fichier Excel sans arrêter la macro ou non, les 2 fichiers CAtProduct et excel correspondants peuvent être fermés et ré-ouverts plus tard. Il faut dans ce cas relancer la macor et cliquer sur "Import".

A tester et a adapter en fonction de ce qu'il vous faut exactement.

WAOUHHH merci beaucoup Marc ça fonctionne parfaitement et va nous faire gagner un temps considérable

Bonjour Marc,

je suis en train d'essayé de modifier la macro afin d'insérer une progress bar pour savoir où en est le programme mais je rencontre encore quelques difficultés.

J'ai trouvé une solution ici :https://catiav5.forumactif.org/t1209-creer-une-progress-barre-dans-catia
mais je n'arrive pas à l'intégrer au bon endroit dans la macro et la faire fonctionner.

As-tu une idée ?

Bonjour Charly,

La difficulté avec les progressbar c'est de définir en avance la fin de l'évènement.
Il y a une autre possibilité que la classe proposée par Docserta:
Il existe un outil spécifique dans la Toolbox des UserForm.
Pour rajouter cet outil :
1.Clic droit dans la fenêtre Toolbox » et « Additional Controls »
2. Cocher « Microsoft ProgressBar Control »
3.Cliquer OK
4.L’outil « ProgressBar » est dispo, il suffit de le glisser dans la UserFrom.


Il faut alors dans la macro  trouver les infos qui permettront de définir le début et la fin de la barre.
Pour l’export on ne sait pas d’avance combien il y aura de ligne (en particulier à cause des composants), mais on peut faire une approche avec le nombre de documents en session (à condition qu’il n’y ait pas trop de CATProduct ouvert simultanément).
'initialisation de la  ProgressBar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = CATIA.Documents.Count + 1
UserForm1.ProgressBar1.Value = 1
Dans la boucle :
  On Error Resume Next 'pour éviter le plantage si le nombre dépasse la valeur max
  UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
  On Error GoTo 0

Pour l’import j’utilise le nombre de ligne du tableau Excel:
nbline = myWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
' initialisation ProgressBar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = nbline - 1
UserForm1.ProgressBar1.Value = 1
Dans la boucle :    UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1

Code principal complété:

Code:

'**********************************************************************
' Macro d'export des propriétés système et utilisateurs d'un assemblage
' Réimport de ces propriétés après modification dans Excel
' Marc Litzler 11/2017
' CATVBA
' http://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa#7113
'**********************************************************************
Public myProduct As Product
Public myDocument As Document
Public myExcel As Object
Public myWorksheet As worksheet
Public line As Integer 'n° de ligne du tableau Excel

Sub CATMain()

'********************************
' Vérifier si le document actif est un CATProduct

On Error Resume Next
Set myDocument = CATIA.ActiveDocument
If Err.Number <> o Then
    MsgBox "Il n'y a pas de fichier ouvert dans CATIA", vbCritical, "Erreur"
    End
End If
If TypeName(myDocument) <> "ProductDocument" Then
    MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
    End
End If
Set myProduct = myDocument.Product

'********************************
' recherche ou déclare l'application Excel

    Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    Set myExcel = CreateObject("Excel.Application")
    myExcel.Visible = True
End If
On Error GoTo 0
'paramétrage progress bar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = CATIA.Documents.Count + 1
UserForm1.ProgressBar1.Value = 1

UserForm1.Show
  
End Sub

'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item
' Source : ---Script by Emmett Ross---www.scripting4v5.com
'
Sub WalkDownTree(oInProduct As Product)

   Dim oInstances As Products
   Set oInstances = oInProduct.Products
   On Error Resume Next
   UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
   On Error GoTo 0
   'Récupère le nom du parent si ce n'est pas le produit de tete:
    If oInProduct.Parent.Name <> myProduct.Parent.Name Then
        myParent = oInProduct.Parent.Parent.ReferenceProduct.Parent.Name
    End If
    'Récupère le nom de fichier du parent (pour recherche composant):
    myRefProductName = oInProduct.ReferenceProduct.Parent.Name

'-----No instances found then this is CATPart

   If oInstances.Count = 0 Then
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Exit Sub
   End If
  
'-----Found an instance therefore it is a CATProduct (ou un composant)
' Au besoins on peut différentier ici le composant du CATProduct
    
    If myParent = myRefProductName Then
        ' C'est un composant
    Else
        ' C'est un Catproduct
    'End If
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            myWorksheet.Range("A" & line & ":N" & line).Interior.Color = 15921390
            line = line + 1
        End If
        End If
Dim k As Integer
    For k = 1 To oInstances.Count
        Dim oInst As Product
        Set oInst = oInstances.Item(k)
        oInstances.Item(k).ApplyWorkMode DESIGN_MODE
        Call WalkDownTree(oInst)
     Next

End Sub
'Fonction qui verifie si la valeur a déjà été exportée
Function isInExcel(valueToCheck)
    isInExcel = False
    For l = 2 To line
        'If myWorksheet.Range("G" & l).Value = valueToCheck Then 'unicité de l'instance
        If myWorksheet.Range("A" & l).Value = valueToCheck Then 'unicité du PartNumber
            isInExcel = True
        End If
    Next
End Function

Code UserForm complété:

Code:

Private Sub CommandButtonEnd_Click()
    UserForm1.Hide
    End
End Sub

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber '"Export"
myWorksheet.Range("A1").Value = "Référence"
myWorksheet.Range("B1").Value = "Révision"
myWorksheet.Range("C1").Value = "Définition"
myWorksheet.Range("D1").Value = "Nomencalture"
myWorksheet.Range("E1").Value = "Source"
myWorksheet.Range("F1").Value = "Description"
myWorksheet.Range("G1").Value = "Instance"
myWorksheet.Range("H1").Value = "MATERIAL"
myWorksheet.Range("I1").Value = "STATE"
myWorksheet.Range("J1").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("K1").Value = "OBSERVATIONS"
myWorksheet.Range("L1").Value = "LENGHT"
myWorksheet.Range("M1").Value = "WIDTH"
myWorksheet.Range("N1").Value = "MASS"
line = 2

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
    Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A1:N1").Font.Bold = True
myWorksheet.Columns("A:N").EntireColumn.AutoFit
 MsgBox "Export terminé"
 UserForm1.ProgressBar1.Value = 1
End Sub

Private Sub CommandButtonImport_Click()
Dim oInProduct As Product
'Vérification de la correspondance du classeur Excel avec le Product
For k = 1 To myExcel.workbooks.Count
Set myWorkbook = myExcel.workbooks.Item(k)
    For i = 1 To myWorkbook.Sheets.Count
        'MsgBox myWorkbook.Sheets.Item(i).Name
        If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
            'Set myWorksheet = myExcel.Sheets.Item(i)
            Exit For
        End If
    Next i
    If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
        Set myWorksheet = myWorkbook.Sheets.Item(i)
        Exit For
    End If
Next k
If myWorksheet.Name <> myProduct.PartNumber Then
 End
End If

Dim myImpDocument 'As Document
Dim myPartNumber As String
Dim nbline As Integer
nbline = myWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'paramétrage progress bar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = nbline - 1
UserForm1.ProgressBar1.Value = 1
line = 2
Do
    'On Error Resume Next
    On Error GoTo 0
    myPartNumber = myWorksheet.Range("A" & line).Value
    If myDocument.Product.PartNumber <> myPartNumber Then
        'Set myImpDocument = CATIA.Documents.Item(myPartNumber)
        Set myImpDocument = myDocument.GetItem(myPartNumber)
        Set oInProduct = myImpDocument
    Else
        'Set myImpDocument = myDocument
        Set oInProduct = myDocument.Product
    End If
      
    Set myparameters = oInProduct.UserRefProperties
    
    'oInProduct.PartNumber = myWorksheet.Range("O" & line).Value
    oInProduct.Revision = myWorksheet.Range("B" & line).Value
    oInProduct.Definition = myWorksheet.Range("C" & line).Value
    oInProduct.Nomenclature = myWorksheet.Range("D" & line).Value
    oInProduct.Source = myWorksheet.Range("E" & line).Value
    oInProduct.DescriptionRef = myWorksheet.Range("F" & line).Value
    'Le renommage des instances ne fonction pas avec cette méthode
    'oInProduct.Name = myWorksheet.Range("G" & line).Value
    On Error Resume Next
    myparameters.Item("MATERIAL").Value = myWorksheet.Range("H" & line).Value
    myparameters.Item("STATE").Value = myWorksheet.Range("I" & line).Value
    myparameters.Item("THICKNESS/DIAMETER").Value = myWorksheet.Range("J" & line).Value
    myparameters.Item("OBSERVATIONS").Value = myWorksheet.Range("K" & line).Value
    myparameters.Item("LENGHT").Value = myWorksheet.Range("L" & line).Value
    myparameters.Item("WIDTH").Value = myWorksheet.Range("M" & line).Value
    myparameters.Item("MASS").Value = myWorksheet.Range("N" & line).Value
    
    line = line + 1
    UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
Loop Until myWorksheet.Range("A" & line).Value = ""
      
    UserForm1.Hide
    MsgBox "Import terminé"
    End
End Sub

Bonjour le forum,


Je me permet de renchérir sur ce post car je n'arrive pas a trouver comment exploiter les propriétés encadrées en rouge dans l'image ci-dessous:



Je voudrais être capable de récupéré le status de la checkbox et (si possible) pouvoir la cocher/décocher.
D'autre part, je voudrais exporter le chemin pour pouvoir comparer les noms d'instance, de part et du fichier lui même pour m'assurer qu'ils sont identiques.

Merci !

Bonjour Simon,

A ma connaissance et d'après plusieurs forum, la coche "Visualiser dans la nomenclature" n'est pas accessible en VBA.

Pour le lien vers la référence, il faut utiliser la propriété "fullname" du document"

Extrait de l'aide:
Property FullName( ) As CATBSTR (Read Only)

Returns the document's full file name, including its path.
Example:
This example retrieves in DocFullName the Doc document's full file name.
DocFullName = Doc.FullName

The returned value is like this:
e:\users\psr\Parts\MyNicePart.CATPart

Bonjour,

Je me permets de relancer le fil de ce message, car cette macro m’intéresse. Je me suis donc permis de la copier et d'essayer ses fonctionnalités.
Hélas, j'ai une erreur lors du lancement en débuggage. Voici une image de celle-ci



l'erreur serai sur la ligne

Code:

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.workbooks.Add

N'ayant aucune notion de programmation, je ne comprends pas d'où vient le problème.

A bientôt.
loic

Bonjour Loïc,

Je n'arrive pas à reproduire ton erreur, chez moi le code fonction.
Quelles sont tes versions de CATIA et Excel?
As tu modifié quelque chose dans le code? Si 'est le cas peux tu le poster pour que je puisse le tester?
As tu bien déclarer Excel? (Public myExcel As Object)
Car dans ton image il n'y a pas de majuscule à Workbooks ce qui signifie que l'éditeur VBA ne l'a pas reconnu comme une fonction VBA.

Set myWorkbook = myExcel.Workbooks.Add

Bonjour lumpazepfel,

Merci d'avoir répondu.
Au travail, la version de Catia est la V5R19 et pour Excel, c'est la 2010.
A la maison, Catia V5 R19 et office 365.
Je ne pourrai tester qu'à partir de lundi sur mon poste au travail, car à la maison avec office 365, je n'ai pas la possibilité d'utiliser la bibliothèque "Microsoft Excel .. Object Library"



Si tu as une idée, je suis preneur car avec Windows 10, "Excel 2010" risque de ne pas être maintenu.

Voici le code que j'ai allégrement copié et retravaillé en fonction de mes besoins.

Code:

Private Sub CommandButtonEnd_Click()
    UserForm1.Hide
    End
End Sub

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.Workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber '"Export"
myWorksheet.Range("A1").Value = "Référence"
myWorksheet.Range("B1").Value = "Révision"
myWorksheet.Range("C1").Value = "Définition"
myWorksheet.Range("D1").Value = "Nomencalture"
myWorksheet.Range("E1").Value = "Source"
myWorksheet.Range("F1").Value = "Description"
myWorksheet.Range("G1").Value = "Instance"
myWorksheet.Range("H1").Value = "MATERIAL"
myWorksheet.Range("I1").Value = "STATE"
myWorksheet.Range("J1").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("K1").Value = "OBSERVATIONS"
myWorksheet.Range("L1").Value = "LENGHT"
myWorksheet.Range("M1").Value = "WIDTH"
myWorksheet.Range("N1").Value = "MASS"
line = 2

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
    Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A1:N1").Font.Bold = True
myWorksheet.Columns("A:N").EntireColumn.AutoFit
 MsgBox "Export terminé"
 UserForm1.ProgressBar1.Value = 1
End Sub

Private Sub CommandButtonImport_Click()
Dim oInProduct As Product
'Vérification de la correspondance du classeur Excel avec le Product
For k = 1 To myExcel.Workbooks.Count
Set myWorkbook = myExcel.Workbooks.Item(k)
    For i = 1 To myWorkbook.Sheets.Count
        'MsgBox myWorkbook.Sheets.Item(i).Name
        If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
            'Set myWorksheet = myExcel.Sheets.Item(i)
            Exit For
        End If
    Next i
    If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
        Set myWorksheet = myWorkbook.Sheets.Item(i)
        Exit For
    End If
Next k
If myWorksheet.Name <> myProduct.PartNumber Then
 End
End If

Dim myImpDocument 'As Document
Dim myPartNumber As String
Dim nbline As Integer
nbline = myWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'paramétrage progress bar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = nbline - 1
UserForm1.ProgressBar1.Value = 1
line = 2
Do
    'On Error Resume Next
    On Error GoTo 0
    myPartNumber = myWorksheet.Range("A" & line).Value
    If myDocument.Product.PartNumber <> myPartNumber Then
        'Set myImpDocument = CATIA.Documents.Item(myPartNumber)
        Set myImpDocument = myDocument.GetItem(myPartNumber)
        Set oInProduct = myImpDocument
    Else
        'Set myImpDocument = myDocument
        Set oInProduct = myDocument.Product
    End If
      
    Set myparameters = oInProduct.UserRefProperties
    
    'oInProduct.PartNumber = myWorksheet.Range("O" & line).Value
    oInProduct.Revision = myWorksheet.Range("B" & line).Value
    oInProduct.Definition = myWorksheet.Range("C" & line).Value
    oInProduct.Nomenclature = myWorksheet.Range("D" & line).Value
    oInProduct.Source = myWorksheet.Range("E" & line).Value
    oInProduct.DescriptionRef = myWorksheet.Range("F" & line).Value
    'Le renommage des instances ne fonction pas avec cette méthode
    'oInProduct.Name = myWorksheet.Range("G" & line).Value
    On Error Resume Next
    myparameters.Item("MATERIAL").Value = myWorksheet.Range("H" & line).Value
    myparameters.Item("STATE").Value = myWorksheet.Range("I" & line).Value
    myparameters.Item("THICKNESS/DIAMETER").Value = myWorksheet.Range("J" & line).Value
    myparameters.Item("OBSERVATIONS").Value = myWorksheet.Range("K" & line).Value
    myparameters.Item("LENGHT").Value = myWorksheet.Range("L" & line).Value
    myparameters.Item("WIDTH").Value = myWorksheet.Range("M" & line).Value
    myparameters.Item("MASS").Value = myWorksheet.Range("N" & line).Value
    
    line = line + 1
    UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
Loop Until myWorksheet.Range("A" & line).Value = ""
      
    UserForm1.Hide
    MsgBox "Import terminé"
    End
End Sub


Pour la variable "Set myWorkbook = myExcel.Workbooks.Add", c'est sur le code du forum qu'il y a cette erreur.



A bientot.
loic

Bonjour Loïc,

Si Excel est installé sur ton PC alors tu dois pouvoir récupérer la bibliothèque VBA associée(je pense que pour office 365 également).
Pour cela, dans Tool References, clique sur Browse... et recherche le fichier EXCEL.EXE qui se trouve par exemple sous "C:\Program Files\Microsoft Office\root\Office16"




Si tu change de version d'EXCEL, il faudra faire la même manip.

Bonsoir Lumpazepfel,

Merci pour l'aide apportée.
En effet, en faisant cette manip, j'arrive à monter la bibliothèque Excel d'office 365.
Bon, après, j'ai d'autres erreurs, mais j'avance tout doucement, c'est bien.
Je ne suis qu'au début de la mise place de l'administration & l'optimisation Catia dans ma société.
Après, j'aurai un autre vaste sujet : les nomenclatures dans Catia j'ai déjà repéré quelques codes sur le forum).

A bientôt.

Loic

Bonsoir Lumpazepfel,

Après avoir remit tout d’aplomb dans le code l'application fonctionne au travail avec CATIA V5R19 et Excel 2010.
Pour la maison avec CATIA V5R19 et Excel 365, c'est plus dur, même en montant la bibliothèque l'application n’arrive pas lancer Excel.
Surement une procédure de lancement différente.
A suivre.
Merci de ton aide.

A bientôt.
loic

Bonjour A tous,
Cette macro est vraiment géniale!
J'ai réussi à la faire fonctionner nickel (sauf la barre de progression ) mais j'ai compensé par un msgbox.
Par contre je rencontre un soucis dans une "évolution" des fonctions:
Je voudrais, lorsque je cherche une propriété personnalisée, si elle n'existe pas, la créer.
J'ai trouvé sur le forum "Macro pour ajout/suppression de propriété" le code suivant:

Code:

Sub CATMain()

Set iProduct = CATIA.ActiveDocument.Product
Set parameters1 = iProduct.UserRefProperties
Set iparameter1 = parameters1.CreateString("Nom de la Propriété", "Valeur de la propriété")

End Sub

J'ai essayé d'adapter ce dernier dans mon code au moment de la recherche:

Code:

          If myparameters.Item("MATIERE") = True Then
                myWorksheet.Range("F" & line).Value = myparameters.Item("DESIGN").Value
            Else
                Set iProduct = CATIA.ActiveDocument.Product
                Set parameters1 = iProduct.UserRefProperties
                Set iparameter1 = parameters1.CreateString("MATIERE", "")
            End If

Mais cela ne semble pas vouloir fonctionner. En tout cas je ne constate aucun changement.
Il y certainement quelque chose qui m'échappe.
Si quelqu'un peut m'éclairer, j'apprécierai beaucoup.

Merci d'avance