Creation/Modification macro propriété

Bonjour Messieurs,

Je suis de retour sur le forum car je souhaite modifier et adapter une macro déjà existante, initié par Lumpafzel qui permet de modifier les propriétés des sous-produits et des parts qui compose un assemblage.

(Ici : https://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa?highlight=propriete)

Pour rappel, la macro génère un fichier excel que l'on peut enregistrer et modifier pour gérer les propriétés dans CATIA.  


Voila ce que je voudrais en faire :

- L'idée c'est dans un premier temps, je souhaiterais avoir un moyen de complètement kill Excel avant le lancement de la macro (des fois la macro n'arrive pas à lancer excel car il est déjà actif dans le gestionnaire des tâche Windows, mais ne se lance pas vraiment).

- Deuxièmement, je souhaiterais la rendre dynamique, je m'explique. Premièrement, ce qui serait génial est de supprimer toutes les propriétés ajoutées (notamment via tracepart etc) dans toutes les parts et tous les sous-assemblages de mon produit.

Ensuite, je souhaiterais choisir à partir d'un fichier Excel quelle propriétés je souhaite ajouter à l'ensemble des éléments de mon arbre de construction.

Pour finir, avant de ré-importer les propriétés je souhaiterais avoir une boite de dialogue me permettant de choisir le fichier excel à utiliser avant la ré-importation (plutot que de l'avoir ouvert lorsque je veux ré-importer).

Y'a du boulot, sachant que j'ai pas eu le temps de faire un code super propre.

Voici le code du module principal :

Code:



'*************************************************************************
'*****  Organisation de l'arbre de construction
'*****  Author: Julien M.
'*****  Date:  22/04/2022
'*****  https://catiav5.forumactif.org/t1759-trier-une-listebox-macro-tri-arbre-de-construction-catia
'*****  http://cao-3d-pro.com/catia-vba-lister-references-et-instances/
'*****  https://cao-3d-pro.com/catia-vba-lister-references-et-fichiers/
'*****  https://cao-3d-pro.com/catia-catdua/
'*************************************************************************
' Il vous faut impérativement être dans un product. Le tri n'ira pas chercher à l'intérieur de chaque product.
'***** NE PAS METTRE DE COMPOSANT !

'-----------------------------------------------------------------------------------------------------------------------------------------------------------
' ----- Déclaration des variables -----
'-----------------------------------------------------------------------------------------------------------------------------------------------------------

Public myProduct As Product
Public myDocument As Document
Public myExcel As Object
Public myWorksheet As Worksheet
Public NombreLigneExcel 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

'-----------------------------------------------------------------------------------------------------------------------------------------------------------
' ----- Initialisation des variables -----
'-----------------------------------------------------------------------------------------------------------------------------------------------------------

Set myProduct = myDocument.Product


'********************************
' Ferme tout les fichiers excel ouvert
'********************************


Set myExcel = GetObject(, "Excel.Application")
myExcel.DisplayAlerts = False
myExcel.Quit

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

FenetreDeCommande.Show
  
End Sub

Sub CreationFichierExcel()

'*************************
'Création du classeur Excel et de la NombreLigneExcel des entêtes
'*************************
Set MyWorkbook = myExcel.workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber
myWorksheet.Range("A2").Value = "N°"
myWorksheet.Range("B2").Value = "PartNumber"
myWorksheet.Range("C2").Value = "Révision"
myWorksheet.Range("D2").Value = "Définition"
myWorksheet.Range("E2").Value = "Nomencalture"
myWorksheet.Range("F2").Value = "Source"
myWorksheet.Range("G2").Value = "Description"
myWorksheet.Range("H2").Value = "Instance"
myWorksheet.Range("I2").Value = "MATERIAL"
myWorksheet.Range("J2").Value = "STATE"
myWorksheet.Range("K2").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("L2").Value = "OBSERVATIONS"
myWorksheet.Range("M2").Value = "LENGHT"
myWorksheet.Range("N2").Value = "WIDTH"
myWorksheet.Range("O2").Value = "MASS"
NombreLigneExcel = 3

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A2:O2").Font.Bold = True
myWorksheet.Range("A2:O2").Font.Size = 20
myWorksheet.Range("A2:O2").Font.Italic = True
myWorksheet.Range("A2:O2").Interior.Color = RGB(22, 54, 92)
myWorksheet.Range("A2:O2").Font.Color = RGB(255, 255, 255)
myWorksheet.Range("A2:O2").Font.Name = "Calibri"
myWorksheet.Range("A2:O2").Borders.Value = 1
myWorksheet.Range("A2:O2").Borders.Weight = 3

myWorksheet.Columns("A:O").EntireColumn.AutoFit

End Sub
'Fonction qui verifie si la valeur a déjà été exportée
Function isInExcel(valueToCheck)
    isInExcel = False
    For l = 3 To NombreLigneExcel
        'If MyWorksheet.Range("G" & l).Value = valueToCheck Then 'unicité de l'instance
        If myWorksheet.Range("B" & l).Value = valueToCheck Then 'unicité du PartNumber
            isInExcel = True
        End If
    Next
End Function
'---------------------------------------------------------------------
'Fonction qui permet de parcourir l'arbre de construction pour récupérer les propriétés
'
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 myParent = myRefProductName Then
        ' C'est un composant
Else
        ' C'est un Catproduct
    If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
        myWorksheet.Range("A" & NombreLigneExcel).Value = NombreLigneExcel - 2
        
        'Mise en forme de la partie des numéros
        myWorksheet.Range("A" & NombreLigneExcel).HorizontalAlignment = xlCenter
        myWorksheet.Range("A" & NombreLigneExcel).Font.Bold = True
        myWorksheet.Range("A" & NombreLigneExcel).Font.Size = 12
        myWorksheet.Range("A" & NombreLigneExcel).Font.Italic = True
        myWorksheet.Range("A" & NombreLigneExcel).Interior.Color = RGB(48, 84, 150)
        myWorksheet.Range("A" & NombreLigneExcel).Font.Color = RGB(255, 255, 255)
        myWorksheet.Range("A" & NombreLigneExcel).Font.Name = "Calibri"
        myWorksheet.Range("A" & NombreLigneExcel).Borders.Value = 0
        myWorksheet.Range("A" & NombreLigneExcel).Borders.Weight = 2
        ' Reprise du code
        
        myWorksheet.Range("B" & NombreLigneExcel).Value = oInProduct.PartNumber
        myWorksheet.Range("C" & NombreLigneExcel).Value = oInProduct.Revision
        myWorksheet.Range("D" & NombreLigneExcel).Value = oInProduct.Definition
        myWorksheet.Range("E" & NombreLigneExcel).Value = oInProduct.Nomenclature
        myWorksheet.Range("F" & NombreLigneExcel).Value = oInProduct.Source
        myWorksheet.Range("G" & NombreLigneExcel).Value = oInProduct.DescriptionRef
        myWorksheet.Range("H" & NombreLigneExcel).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("I" & NombreLigneExcel).Value = myparameters.Item("MATERIAL").Value
        myWorksheet.Range("J" & NombreLigneExcel).Value = myparameters.Item("STATE").Value
        myWorksheet.Range("K" & NombreLigneExcel).Value = myparameters.Item("THICKNESS/DIAMETER").Value
        myWorksheet.Range("L" & NombreLigneExcel).Value = myparameters.Item("OBSERVATIONS").Value
        myWorksheet.Range("M" & NombreLigneExcel).Value = myparameters.Item("LENGHT").Value
        myWorksheet.Range("N" & NombreLigneExcel).Value = myparameters.Item("WIDTH").Value
        myWorksheet.Range("O" & NombreLigneExcel).Value = myparameters.Item("MASS").Value
        On Error GoTo 0
        myWorksheet.Range("B" & NombreLigneExcel & ":O" & NombreLigneExcel).Interior.Color = 15921390
        myWorksheet.Range("B" & NombreLigneExcel & ":O" & NombreLigneExcel).Borders.Value = 0
        myWorksheet.Range("B" & NombreLigneExcel & ":O" & NombreLigneExcel).Borders.Weight = 2
        myWorksheet.Range("B" & NombreLigneExcel & ":O" & NombreLigneExcel).Font.Name = "Bahnschrift Light"
        
        NombreLigneExcel = NombreLigneExcel + 1
    End If
End If

' Ici je suppose que cela permet d'analyser les sous-produits et les part qui le composent

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




Code de la userform :

Code:



Private Sub CommandButtonEnd_Click()

' Ferme la MACRO
FenetreDeCommande.Hide
End


End Sub

Private Sub CommandButtonExport_Click()

CreationFichierExcel
    
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
NombreLigneExcel = 3
Do
    'On Error Resume Next
    On Error GoTo 0
    myPartNumber = myWorksheet.Range("B" & NombreLigneExcel).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" & NombreLigneExcel).Value '--> pour modifier le PartNumber
    oInProduct.Revision = myWorksheet.Range("C" & NombreLigneExcel).Value
    oInProduct.Definition = myWorksheet.Range("D" & NombreLigneExcel).Value
    oInProduct.Nomenclature = myWorksheet.Range("E" & NombreLigneExcel).Value
    oInProduct.Source = myWorksheet.Range("F" & NombreLigneExcel).Value
    oInProduct.DescriptionRef = myWorksheet.Range("G" & NombreLigneExcel).Value
    'Le renommage des instances ne fonction pas avec cette méthode
    'oInProduct.Name = myWorksheet.Range("G" & NombreLigneExcel).Value
    On Error Resume Next
    myparameters.Item("MATERIAL").Value = myWorksheet.Range("I" & NombreLigneExcel).Value
    myparameters.Item("STATE").Value = myWorksheet.Range("J" & NombreLigneExcel).Value
    myparameters.Item("THICKNESS/DIAMETER").Value = myWorksheet.Range("K" & NombreLigneExcel).Value
    myparameters.Item("OBSERVATIONS").Value = myWorksheet.Range("L" & NombreLigneExcel).Value
    myparameters.Item("LENGHT").Value = myWorksheet.Range("M" & NombreLigneExcel).Value
    myparameters.Item("WIDTH").Value = myWorksheet.Range("N" & NombreLigneExcel).Value
    myparameters.Item("MASS").Value = myWorksheet.Range("O" & NombreLigneExcel).Value
    
    NombreLigneExcel = NombreLigneExcel + 1
Loop Until myWorksheet.Range("B" & NombreLigneExcel).Value = ""
      
    
    FenetreDeCommande.Hide
    MsgBox "Import terminé"
    End
End Sub

Private Sub Label3_Click()

End Sub

Private Sub Label4_Click()

End Sub




Salut,

J'ai le même problème avec Excel qui fait planter les macros CATIA. Pour y remédier j'ai choisi d'ouvrir un fichier Excel existant plutôt que de le créer. ça permet en plus de faire un fichier template déjà configurer avec les noms des colonnes, les mise en forme voir même des macros. Cela réduit aussi le nombre de lignes du code CATIA.

Code:


Set  xlsTemplate = "c/temp/templateexport.xls"
Set myExcel = CreateObject("Excel.Application")
Set myWorkbook = myExcel.Workbooks.Open(xlsTemplate)
myExcel.visible=true


Pour naviguer dans les dossiers et ouvrir un fichier:

Code:

Set FileSys = CATIA.FileSystem
fpath = CATIA.FileSelectionBox("Selectionner un fichier", "*.XLS;*.XLSX", CatFileSelectionModeOpen)
Set xlsFile = FileSys.GetFile(fpath)
Set myExcel = CreateObject("Excel.Application")
myExcel.Visible = True
Set myWorkbook = myExcel.Workbooks.Open(xlsFile.Path)

Ok super je te remercie.

J'en suis arrivé au point où je peux supprimer toutes les propriétés de chaque élément de l'arbre, importer celle que je veux en allant chercher un fichier Excel pré-enregistrer, (avec boite de dialogue comme tu m'as montré) puis modifier ces propriétés dans l'excel puis le ré-importer.

Petit hic pour ré-importer je dois avoir l'excel d'ouvert, mais je vais changer ça de manière à aller le chercher avec une boite de dialogue.

Pour les intéressé, demandez-moi la macro si elle peut vous servir.

Julien

Salut Lumpazeopfel,


Si jamais ça peut te servir voici une fonction qui permet de kill complètement Excel dans le gestionnaire de tâche avant le lancement d'instruction, ce qui permet d'éviter certains bug...

Code:



Sub Test()
    If TaskKill("excel.exe") = 0 Then MsgBox "Terminated" Else MsgBox "Failed"
End Sub

Function TaskKill(sTaskName)
    TaskKill = CreateObject("WScript.Shell").Run("taskkill /f /im " & sTaskName, 0, True)
End Function




Je l'ai testé et ça fonctionne, mais je n'ai pas encore essayé de l'intégrer dans mon code pour voir si c’est efficace. Je ferai u update

Julien

Re Marc,

Je pense atteindre mon "dernier" problème sur la macro...

Impossible d'agir sur une part venant de tracepart (modifier un champ de propriétés ou en supprimer une, et j'arrive pas à comprendre pourquoi). Alors que tout fonctionne pour les autres...

Update :

Sujet résolu ! J'ai finalement réussis à intégrer toutes les fonctions d'importation, de modification et d'importation des propriétés.

Je ne sais pas comment placer le sujet en résolu :/

Mreci !