Macro pilote tableau catia via excel

Bonjour,

Je souhaiterai crée un outils permettant de créer des tableau dans plusieurs calque sous Catia que je pourrais après piloter via Excel,
pour le moment j'ai trouvé la solution des collages spéciaux, mais cela ne donne pas vraiment la mise en forme voulu, j'ai vu qu'il était possible
de faire cela via des macros, mais je suis un peu perdu sous Catia...

Pour aller plus loin dans l'explication de mon problème :
Je travaille actuellement sur une mise en plan d'un assemblage comportant plusieurs support et chacun des supports a son calque (300 feuilles)
et dans chacun des calques sont répertorié la visserie et autre, le problème est que après le passage en calcul la visserie viens à changer assez régulièrement à chaque nouvelle indice en gros, j'ai donc créer une feuille comportant chaque tableau de chacun des supports et j'aimerai maintenant les intégrer dans les calque Catia et pouvoir modifier les valeurs via ma feuille Excel, le but serait que n'importe quelle personne ayant accès à cette feuille Excel puissent piloter les valeurs sous Catia

Merci d'avance pour votre aide

Bonjour Aurélien,

Il est tout à fait possible de copier les valeurs d'un tableau Excel vers un tableau dans un CATDrawing à l'aide d'une macro VBA soit dans CATIA soit dans Excel.
Si j'ai bien compris c'est ton Excel qui pilote les valeurs à renseigner dans CATIA. Il faut alors trouver un moyen de lier chaque feuille Excel au calque CATIA correspondant ( en lui donnant le même nom par exemple).
Ci dessous un petit code de départ (en VBA CATIA) qui copie un tableau Excel de 3 colonnes x 20 lignes dans un CATDrawing.  

Code:

Sub catmain()

'Vérifier qu'un CATDrawing est actif
On Error Resume Next
Set mydrawing = CATIA.ActiveDocument
    If (Err.Number <> 0) Then
        MsgBox ("Un CATDrawing doit être actif")
        Exit Sub
    End If
On Error GoTo 0
If (InStr(mydrawing.Name, ".CATDrawing")) = 0 Then
    MsgBox ("La fenêtre active doit être un CATDrawing")
    Exit Sub
End If

    Set DrwSheets = mydrawing.Sheets
    Set DrwParameters = mydrawing.Parameters

'Déclare l'application excel
Dim myExcel 'As Excel.Application

'*** Vérifier qu'un XLS est ouvert ***
On Error Resume Next
Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    MsgBox ("Il faut ouvrir le fichier Excel")
    Exit Sub
End If

Dim myWorkbook 'As Workbook
Set myWorkbook = myExcel.ActiveWorkbook
Dim myWorksheet 'As Worksheet
Set myWorksheet = myWorkbook.ActiveSheet
nbligneXLS = 20
nbligneTAB = 0
Dim myArray() As String
ReDim myArray(20, 3) As String
'** V01 **
Dim myStartRow As Integer
myStartRow = 1 'ligne de départ dans Excel
Dim myEndRow As Integer
myEndRow = nbligneXLS
Dim myReference As String

'Création d'un tableau tampon

For i = myStartRow To myEndRow
    If myWorksheet.Cells(i, 1).Value <> 0 Then
        ReDim Preserve myArray((nbligneTAB + 1), 2) 'As String
        myArray(nbligneTAB, 0) = myWorksheet.Cells(i, 1).Value
        myArray(nbligneTAB, 1) = myWorksheet.Cells(i, 2).Value
        myArray(nbligneTAB, 2) = myWorksheet.Cells(i, 3).Value
        nbligneTAB = nbligneTAB + 1
    End If
Next

'*** Création d'une vue pour le tableau ***

Dim myDrawingSheet As DrawingSheet
Set myDrawingSheet = mydrawing.Sheets.ActiveSheet
Dim drawingViews1 As DrawingViews
Set drawingViews1 = myDrawingSheet.Views
Dim myDrawingSheetView As DrawingView
Set myDrawingSheetView = drawingViews1.Add("Tableau")
myDrawingSheetView.X = 220
myDrawingSheetView.Y = 30
myDrawingSheetView.Activate

'*** Création du tableau dans le CATDrawing***

Dim myDrawingTable As DrawingTable
Set myDrawingTable = myDrawingSheetView.Tables.Add(0#, 0#, nbligneTAB + 2, 3, 10, 50)
myDrawingTable.MergeCells 1, 1, 1, 3
myDrawingTable.Name = "TableauImportExcel"
myDrawingTable.AnchorPoint = CatTableBottomLeft
'ligne titre
myDrawingTable.SetCellString 1, 1, "Valeurs importées d'Excel"
myDrawingTable.SetCellAlignment 1, 1, CatTableMiddleCenter

'Remplisssage des lignes
For i = 0 To nbligneTAB - 1
    myDrawingTable.SetCellString i + 2, 1, myArray(i, 0)
    myDrawingTable.SetCellAlignment i + 2, 1, CatTableMiddleCenter
    myDrawingTable.SetCellString i + 2, 2, myArray(i, 1)
    myDrawingTable.SetCellAlignment i + 2, 2, CatTableMiddleLeft
    myDrawingTable.SetCellString i + 2, 3, myArray(i, 2)
    myDrawingTable.SetCellAlignment i + 2, 3, CatTableMiddleLeft
Next i

'mise en forme
myDrawingTable.SetColumnSize 1, 20
myDrawingTable.SetColumnSize 2, 0  '0 pour largeur automatique
If (myDrawingTable.GetColumnSize(2)) < 100 Then
    myDrawingTable.SetColumnSize 2, 100 'taille mini
End If

End Sub


Merci beaucoup Marc, juste une petite question supplémentaire faut-il une feuille Excel différente pour chaque calque ou on peut mettre plusieurs tableau dans une même feuille pour diffèrent calque ?

Salut Aurélien,

Je n'ai pas toutes les données pour te répondre, mais je pense effectivement qu'il faudrait un fichier Excel par Catdrawing contenant une feuille par tableau et donc par calque.
Tu peux éventuellement poster quelques images pour illustrer ton besoins.

Donc sur la photo du haut tu as mon tableau Catia et sur celle du bas mon tableau excel qui regroupe chaque tableau catia, et le but serait enfaite de modifier mes tableaux catia en modifiant mes valeurs excel

Ci-joint une autre photo peut être plus clair

En fait tu peux faire comme tu veux, une feuille par calc ou tout sur la même, c'est la macro c'est selon comment tu programme ta macro.

Par contre, je ne sais pas si tu peux a partir d'Excel, afficher un calque ou un autre d'un même plan (je pense que oui, mais avec catia, tant qu'on ne l'a pas fait on ne peux pas savoir)

Perso j'ai fais des macros qui permettent depuis catia, d'ouvrir Excel, d'y importer des données depuis catia, dont une macro, qui ensuite permet à excel de renvoyer les données vers Catia (fouille dans le sujet de tête de la catégorie macros)

Salut Aurélien,

Ça devrait être faisable
Encore quelques précisions:
-ne veux tu que modifier les tableaux ou également les créer au départ?
-est ce que ton CATDrawing comporte autant de calque qu'il y a de tableau dans excel?
-si oui est il possible de les nommer de la même façon que le tableau (MSX....) ?
-dans le Catdrawing, est ce que le tableau est dans une vue particulière (j'ai l'impression qu'il est dans le calque du fond comme le cartouche) ?

Salut Marc

Alors pour répondre à tes questions :
Je voudrais juste les modifier
Le catdrawing comporte autant de calque que de tableau (1msx = 1 calque)
Dans le catdrawing ils sont déjà nommer "MSX0000G0"
Les tableaux ont malheureusement été créer dans le fond de calque mais cela ne m'embêterais pas qu'il soit dans une vue.

Guss_ a écrit:En fait tu peux faire comme tu veux, une feuille par calc ou tout sur la même, c'est la macro c'est selon comment tu programme ta macro.

Par contre, je ne sais pas si tu peux a partir d'Excel, afficher un calque ou un autre d'un même plan (je pense que oui, mais avec catia, tant qu'on ne l'a pas fait on ne peux pas savoir)

Perso j'ai fais des macros qui permettent depuis catia, d'ouvrir Excel, d'y importer des données depuis catia, dont une macro, qui ensuite permet à excel de renvoyer les données vers Catia (fouille dans le sujet de tête de la catégorie macros)

Oui j'ai trouvé plusieurs de tes macros j'ai essayé de les reprendre mais je t'avoue que je suis pas un expert VBA...

J'avais trouvé celle ci :

Code:

Sub CATMain()
'--- initialisation objet nomenclateur
    Dim drawingDocument1 As DrawingDocument
    Dim drawingSheets1 As DrawingSheets
    Dim drawingSheet1 As DrawingSheet
    Dim drawingViews1 As DrawingViews
    Dim drawingView1 As DrawingView
    Dim drawingTables1 As DrawingTables
    Dim nomenclature As DrawingTable
    Set drawingDocument1 = CATIA.ActiveDocument
    Set drawingSheets1 = drawingDocument1.Sheets
    Set drawingSheet1 = drawingSheets1.Item("Calque.1")
    Set drawingViews1 = drawingSheet1.Views
    Set drawingView1 = drawingViews1.Item("Main View")
    Set drawingTables1 = drawingView1.Tables
'---- test si un taleau existe si non on le créé
    On Error Resume Next
    Set nomenclature = drawingTables1.Item(1)
    If Err.Number <> 0 Then
        Set nomenclature = drawingTables1.Add(0, 0, 1, 5, 5, 200 / 5)
        With nomenclature
            .SetCellString 1, 1, "N°Plan"
            .SetCellString 1, 2, "Ind."
            .SetCellString 1, 3, "Nb"
            .SetCellString 1, 4, "Désignation"
            .SetCellString 1, 5, "Observations"
            .SetColumnSize 1, 28
            .SetColumnSize 2, 10
            .SetColumnSize 3, 10
            .SetColumnSize 4, 90
            .SetColumnSize 5, 62
            For C = 1 To 5
                With .GetCellObject(1, C)
                    .SetFontSize 0, 0, 2.3
                End With
            Next
        End With
    End If
'---- initialisation variables de traiement
    Dim colonnes As Long
    Dim lignes As Long
    colonnes = nomenclature.NumberOfColumns
    lignes = nomenclature.NumberOfRows
'---- initialisation excel
    Dim Excel As Object
    On Error Resume Next
    Set Excel = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set Excel = CreateObject("Excel.Application")
        Excel.Visible = True
    End If
    On Error GoTo 0
    Excel.Visible = True
    Excel.Workbooks.Add
    Set wbks = Excel.ActiveWorkbook
    Set wbk = wbks.Sheets(1)
'------- passage catia -> excel
    For l = 1 To lignes
        For C = 1 To colonnes
            wbk.Cells(l, C) = nomenclature.GetCellString(l, C)
            wbk.Cells(l, C).borders.LineStyle = 1
            wbk.Cells(l, C).borders.Weight = 2
        Next
    Next
'------ mis en page excel
    wbk.Columns(1).ColumnWidth = 14.29
    wbk.Columns(2).ColumnWidth = 2.57
    wbk.Columns(3).ColumnWidth = 4.43
    wbk.Columns(4).ColumnWidth = 44.71
    wbk.Columns(5).ColumnWidth = 28.71
'---- initialisation bouton de mise à jour excel
    Dim Obj As Object
    Dim Code As String
'---- create button
    Set Obj = wbk.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=550, Top:=0, Width:=100, Height:=35)
    Obj.Name = "Bouton_MAJ"
'---- buttonn text
    wbk.Bouton_MAJ.Caption = "Mise à jour de la nomenclature"
    wbk.Bouton_MAJ.WordWrap = True
    wbk.Bouton_MAJ.TakeFocusOnClick = False
'---- macro text
    Code = Code & "Private Sub Bouton_MAJ_Click()" & vbCrLf
    Code = Code & " " & vbCrLf
    Code = Code & "'---- initialisation catia" & vbCrLf
    Code = Code & "    Dim Catia As Object" & vbCrLf
    Code = Code & "    On Error Resume Next" & vbCrLf
    Code = Code & "    Set Catia = GetObject(, ""CATIA.Application"")" & vbCrLf
    Code = Code & "    If Err.Number <> 0 Then" & vbCrLf
    Code = Code & "        MsgBox (""pas de session catia trouvée"")" & vbCrLf
    Code = Code & "    Else" & vbCrLf
    Code = Code & "        On Error GoTo 0" & vbCrLf
    Code = Code & "        Set drawingDocument1 = Catia.ActiveDocument" & vbCrLf
    Code = Code & "        Set drawingSheets1 = drawingDocument1.Sheets" & vbCrLf
    Code = Code & "        Set drawingSheet1 = drawingSheets1.Item(""Calque.1"")" & vbCrLf
    Code = Code & "        Set drawingViews1 = drawingSheet1.Views" & vbCrLf
    Code = Code & "        Set drawingView1 = drawingViews1.Item(""Main View"")" & vbCrLf
    Code = Code & "        Set drawingTables1 = drawingView1.Tables" & vbCrLf
    Code = Code & "        Set nomenclature = drawingTables1.Item(1)" & vbCrLf
    Code = Code & "'---- determine nombre de ligne de la nomenclature" & vbCrLf
    Code = Code & "        Dim l, lignes As Long" & vbCrLf
    Code = Code & "        l = 1" & vbCrLf
    Code = Code & "        While Cells(l, 1) <> ""N°Plan""" & vbCrLf
    Code = Code & "            l = l + 1" & vbCrLf
    Code = Code & "            if l>150 then" & vbCrLf
    Code = Code & "                MsgBox (""case 'N°Plan' non trouvée"")" & vbCrLf
    Code = Code & "                Exit Sub" & vbCrLf
    Code = Code & "            end if" & vbCrLf
    Code = Code & "        Wend" & vbCrLf
    Code = Code & "'---- lit taille de la nomenclature existante" & vbCrLf
    Code = Code & "        lignes = nomenclature.NumberOfRows" & vbCrLf
    Code = Code & "'---- redimentionna la nomenclature Catia" & vbCrLf
    Code = Code & "        If lignes < l Then" & vbCrLf
    Code = Code & "            lignes = l - lignes" & vbCrLf
    Code = Code & "            For t = 1 To lignes" & vbCrLf
    Code = Code & "                nomenclature.AddRow 0" & vbCrLf
    Code = Code & "                nomenclature.Y = nomenclature.Y + 5" & vbCrLf
    Code = Code & "            Next" & vbCrLf
    Code = Code & "        Else" & vbCrLf
    Code = Code & "            lignes = lignes - l" & vbCrLf
    Code = Code & "            For t = 1 To lignes" & vbCrLf
    Code = Code & "                nomenclature.RemoveRow 0" & vbCrLf
    Code = Code & "                nomenclature.Y = nomenclature.Y - 5" & vbCrLf
    Code = Code & "            Next" & vbCrLf
    Code = Code & "        End If" & vbCrLf
    Code = Code & "'---- passage excel -> Catia" & vbCrLf
    Code = Code & "        For ligne = 1 To l" & vbCrLf
    Code = Code & "            For colonne = 1 To 5" & vbCrLf
    Code = Code & "                nomenclature.SetCellString ligne, colonne, Cells(ligne, colonne)" & vbCrLf
    Code = Code & "            Next" & vbCrLf
    Code = Code & "        Next" & vbCrLf
    Code = Code & "        Dim sFilePath As String" & vbCrLf
    Code = Code & "        Dim sFileName As String" & vbCrLf
    Code = Code & "        Dim sModule As String" & vbCrLf
    Code = Code & "        Dim sProcedure As String" & vbCrLf
    Code = Code & "        Dim sFilePathAndName As String" & vbCrLf
    Code = Code & "        Dim CatSysServ As Variant" & vbCrLf
    Code = Code & "        Dim Params() As Variant" & vbCrLf
    Code = Code & "        Dim vRetVal As Variant" & vbCrLf
    Code = Code & "        Dim catScriptLibraryType As Integer" & vbCrLf
    Code = Code & "'---- Everything here is Case-Sensitive" & vbCrLf
    Code = Code & "        sFilePath = ""G:\BUREAU_ETUDES\Catia\Macro\test""" & vbCrLf
    Code = Code & "        sFileName = ""test.catvba""" & vbCrLf
    Code = Code & "        catScriptLibraryType = 2" & vbCrLf
    Code = Code & "        sModule = ""nomenclature""" & vbCrLf
    Code = Code & "        sProcedure = ""mise_a_jour_table"" 'CatMain is only allowable Choice" & vbCrLf
    Code = Code & "'---- Concate File Path and Name" & vbCrLf
    Code = Code & "        sFilePathAndName = sFilePath & ""\"" & sFileName" & vbCrLf
    Code = Code & "        Set CatSysServ = CATIA.SystemService" & vbCrLf
    Code = Code & "        vRetVal = CatSysServ.ExecuteScript(sFilePathAndName, catScriptLibraryType, sModule, sProcedure, Params)" & vbCrLf
    Code = Code & "'---- vRetVal only gets a value *if* the called macro *is* as Function," & vbCrLf
    Code = Code & "'---- otherwise it's 'Empty'." & vbCrLf
    Code = Code & "        thisworkbook.Close SaveChanges:=False" & vbCrLf
    Code = Code & "    End If" & vbCrLf
    Code = Code & "End Sub" & vbCrLf
'---- add macro at the end of the sheet module
    With wbks.VBProject.VBComponents(wbk.Name).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
    nomenclature.ComputeMode = CatTableComputeOFF

End Sub

Sub mise_a_jour_table()
'--- initialisation objet nomenclateur
    Dim drawingDocument1 As DrawingDocument
    Dim drawingSheets1 As DrawingSheets
    Dim drawingSheet1 As DrawingSheet
    Dim drawingViews1 As DrawingViews
    Dim drawingView1 As DrawingView
    Dim drawingTables1 As DrawingTables
    Dim nomenclature As DrawingTable
    Set drawingDocument1 = CATIA.ActiveDocument
    Set drawingSheets1 = drawingDocument1.Sheets
    Set drawingSheet1 = drawingSheets1.Item("Calque.1")
    Set drawingViews1 = drawingSheet1.Views
    Set drawingView1 = drawingViews1.Item("Main View")
    Set drawingTables1 = drawingView1.Tables
    Set nomenclature = drawingTables1.Item(1)
    nomenclature.ComputeMode = CatTableComputeOFF
    Dim l, r As Integer
    l = nomenclature.NumberOfRows
    For r = 1 To l
'--- mise en page du tableau catia
        nomenclature.SetCellAlignment r, 1, CatTableMiddleCenter
        nomenclature.SetCellAlignment r, 2, CatTableMiddleCenter
        nomenclature.SetCellAlignment r, 3, CatTableMiddleCenter
        nomenclature.SetCellAlignment r, 4, CatTableMiddleLeft
        nomenclature.SetCellAlignment r, 5, CatTableMiddleLeft
    Next
    nomenclature.ComputeMode = CatTableComputeON
  
End Sub

Qui pourrais correspondre parfaitement mais il faudrait que je modifie plusieurs chose mais je ne sais pas trop par où commencer

salut,

Il faut que tu y ailles petit à petit.

Commence par détecter la session catia, depuis excel
ensuite ajoute des données dans un tableau catia existant
après tu étofferas.

Ma macro fait pas mal de petites chose en plus.

Ce qui peut t'intérésser est cette partie, qui fonctionne à partir de Excel

Code:


Private Sub Bouton_MAJ_Click()
   
    '---- initialisation catia met en place les variable pour gérer le session les objets catia depuis excel
        Dim Catia As Object
        On Error Resume Next
        Set Catia = GetObject(, ""CATIA.Application"")
        If Err.Number <> 0 Then
            MsgBox (""pas de session catia trouvée"")
        Else
            On Error GoTo 0
            Set drawingDocument1 = Catia.ActiveDocument
            Set drawingSheets1 = drawingDocument1.Sheets
            Set drawingSheet1 = drawingSheets1.Item(""Calque.1"")
            Set drawingViews1 = drawingSheet1.Views
            Set drawingView1 = drawingViews1.Item(""Main View"")
            Set drawingTables1 = drawingView1.Tables
            Set nomenclature = drawingTables1.Item(1)

    '---- determine nombre de ligne de la nomenclature( dans mon fichier excel j'ai une cellule qui est remplie avec "N°Plan" qui permet de déterminer le nombre de lignes que comporte le tableau excel à transmettre, tu peux modifier en fonction de ton besoin ou faire autrement
            Dim l, lignes As Long
            l = 1
            While Cells(l, 1) <> ""N°Plan""
                l = l + 1
                if l>150 then
                    MsgBox (""case 'N°Plan' non trouvée"")
                    Exit Sub
                end if
            Wend
    '---- lit taille de la nomenclature existante
            lignes = nomenclature.NumberOfRows

    '---- redimentionne la nomenclature Catia
            If lignes < l Then
                lignes = l - lignes
                For t = 1 To lignes
                    nomenclature.AddRow 0
                    nomenclature.Y = nomenclature.Y + 5
                Next
            Else
                lignes = lignes - l
                For t = 1 To lignes
                    nomenclature.RemoveRow 0
                    nomenclature.Y = nomenclature.Y - 5
                Next
            End If
    '---- copie des données excel -> Catia
            For ligne = 1 To l
                For colonne = 1 To 5
                    nomenclature.SetCellString ligne, colonne, Cells(ligne, colonne)
                Next
            Next

'---- a partir d'ici la macro excel tente de lancer une macro dans catia qui dans mon cas me permet d'accélérer le passage de catia à excel puis excel vers catia, tu ne devrais pas en avoir besoin


            Dim sFilePath As String
            Dim sFileName As String
            Dim sModule As String
            Dim sProcedure As String
            Dim sFilePathAndName As String
            Dim CatSysServ As Variant
            Dim Params() As Variant
            Dim vRetVal As Variant
            Dim catScriptLibraryType As Integer
    '---- Everything here is Case-Sensitive
            sFilePath = ""G:\BUREAU_ETUDES\Catia\Macro\test""
            sFileName = ""test.catvba""
            catScriptLibraryType = 2
            sModule = ""nomenclature""
            sProcedure = ""mise_a_jour_table"" 'CatMain is only allowable Choice
    '---- Concate File Path and Name
            sFilePathAndName = sFilePath & ""\"" & sFileName
            Set CatSysServ = CATIA.SystemService
            vRetVal = CatSysServ.ExecuteScript(sFilePathAndName, catScriptLibraryType, sModule, sProcedure, Params)
    '---- vRetVal only gets a value *if* the called macro *is* as Function,
    '---- otherwise it's 'Empty'.
            thisworkbook.Close SaveChanges:=False
        End If
    End Sub

Salut Aurélien

Voici la première partie du code qui permet de mettre à jour les tableaux existants.
Le fichier Excel doit respecter la configuration que tu postée (valeurs dans les colonnes B à G, titre et légendes identiques, maximum 2 ligne vides entre les tableaux. Coté CATIA, le tableau existant doit porter le même nom "MSX***".

IL reste la partie création à faire.

Code:


'*******************************************************************************************************
'
'https://catiav5.forumactif.org/t1789-macro-pilote-tableau-catia-via-excel#7650
' Création et mise à jour de Drawing tabledans un CATDrawing à partir de tableaux d'un fichiers Excel
' Marc Litzler 11/2022
'
'*******************************************************************************************************

'définition d'un nouveau type de variable:
'tableau contenant le nom, la première et la dernière ligne de chaque tableau excel
Type TabExcel
TName As String
TFirstRow As Integer
TLastRow As Integer
End Type
Public xlsTab() As TabExcel
Public myWorksheet 'As Worksheet
Public myDrawing
Public myDrwSheets As DrawingSheets
Public myDrawingTable As DrawingTable


Sub CATMain()
Dim tableFound As Boolean
Dim myTabName As String
'Vérifier qu'un CATDrawing est actif
On Error Resume Next
Set myDrawing = CATIA.ActiveDocument
    If (Err.Number <> 0) Then
        MsgBox ("Un CATDrawing doit être actif")
        Exit Sub
    End If
On Error GoTo 0
If (InStr(myDrawing.Name, ".CATDrawing")) = 0 Then
    MsgBox ("La fenêtre active doit être un CATDrawing")
    Exit Sub
End If

    Set myDrwSheets = myDrawing.Sheets

'Déclare l'application excel
Dim myExcel 'As Excel.Application

'*** Vérifier qu'un XLS est ouvert ***
On Error Resume Next
Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    MsgBox ("Il faut ouvrir le fichier Excel")
    Exit Sub
End If
On Error GoTo 0

Dim myWorkbook 'As Workbook
Set myWorkbook = myExcel.ActiveWorkbook
Set myWorksheet = myWorkbook.ActiveSheet

' **********************************
' ici on peut vérifier si le fichier Excel correspond bien au CATDrawing,
' par exemple en comparant myWorksheet.name et myDrawing.name
' **********************************

'on scanne le fichier Excel pour trouver les différents tableaux, on inscrit le nom, la première et la dernière ligne de chacun.

Dim rowXLS As Integer
Dim rowTab As Integer
rowXLS = 1
rowTab = 0
ReDim xlsTab(0)
'scanne la colonne B jusqu'à qu'il y ait 3 lignes vides:
Do Until (myWorksheet.Cells(rowXLS, 2).Value = "" And myWorksheet.Cells(rowXLS + 1, 2).Value = "" And myWorksheet.Cells(rowXLS + 2, 2).Value = "")
    If rowXLS > 2000 Then
        MsgBox "Erreur de boucle" ' sécurité pour sortir de la boucle
        Exit Sub
    End If
    If myWorksheet.Cells(rowXLS, 2).Value = "POIDS TOTAL" Then
        xlsTab(rowTab).TName = (myWorksheet.Cells(rowXLS - 1, 2).Value)
        xlsTab(rowTab).TFirstRow = rowXLS - 1
    End If
    If myWorksheet.Cells(rowXLS, 2).Value = "N°" Then
        xlsTab(rowTab).TLastRow = rowXLS
        rowTab = rowTab + 1
        ReDim Preserve xlsTab(UBound(xlsTab) + 1)
    End If
    rowXLS = rowXLS + 1
Loop

Call tabSearch

End Sub

'***********************************
' Recherche des tableaux existants
'***********************************
Sub tabSearch()

Dim t As Integer
For t = 0 To UBound(xlsTab) - 1
    myTabName = xlsTab(t).TName
    Dim selection1 As Selection
    Set selection1 = myDrawing.Selection
    selection1.Search "(CAT2DLSearch.DrwTable + CATDrwSearch.DrwTable) & Name= " & myTabName
    If selection1.Count = 0 Then
        rep = MsgBox("Voulez vous créer: " & myTabName & "?", vbYesNo, "Création tableau")
        If rep = vbYes Then
            Call createTab(t)
          End If
    Else
        rep = MsgBox("Voulez vous mettre à jour: " & myTabName & "?", vbYesNo, "Tableau trouvé")
        If rep = vbYes Then
            Set SelectedElement1 = selection1.Item(1)
            Set myDrawingTable = SelectedElement1.Value
            Call updateTab(t)
        End If
    End If
Next
End Sub

'***********************************
' Mise à jour d'un tableau existant
'***********************************
Sub updateTab(table As Integer)

rowTab = 1
For rowXLS = xlsTab(table).TFirstRow To xlsTab(table).TLastRow
        CATIA.Caption = "Ligne : " & rowXLS
        myDrawingTable.SetCellString rowTab, 1, myWorksheet.Cells(rowXLS, 2).Value
        myDrawingTable.SetCellString rowTab, 2, myWorksheet.Cells(rowXLS, 3).Value
        myDrawingTable.SetCellString rowTab, 3, myWorksheet.Cells(rowXLS, 4).Value
        myDrawingTable.SetCellString rowTab, 4, myWorksheet.Cells(rowXLS, 5).Value
        myDrawingTable.SetCellString rowTab, 5, myWorksheet.Cells(rowXLS, 6).Value
        myDrawingTable.SetCellString rowTab, 6, myWorksheet.Cells(rowXLS, 7).Value
        rowTab = rowTab + 1
Next
    
End Sub

'***********************************
' Création d'un nouveau tableau
'***********************************
Sub createTab(table As Integer)
myTabName = xlsTab(table).TName
myDrwSheets.Item(myTabName).Activate 'active le calque portant le même nom que le tableau
myDrwSheets.Item(myTabName).Views.Item(2).Activate 'active le calque du fond
'à faire
End Sub




Hello,

Voici le code avec la partie création de tableau rajouté.
Il faut qu'un calque portant le même nom que le tableau existe dans le CATDrawing.

Code:


'*******************************************************************************************************
'
'https://catiav5.forumactif.org/t1789-macro-pilote-tableau-catia-via-excel#7650
' Création et mise à jour de Drawing tabledans un CATDrawing à partir de tableaux d'un fichiers Excel
' Marc Litzler 11/2022
'
'*******************************************************************************************************

'définition d'un nouveau type de variable:
'tableau contenant le nom, la première et la dernière ligne de chaque tableau excel
Type TabExcel
TName As String
TFirstRow As Integer
TLastRow As Integer
End Type
Public xlsTab() As TabExcel
Public myWorksheet 'As Worksheet
Public myDrawing
Public myDrwSheets As DrawingSheets
Public myDrawingTable As DrawingTable


Sub CATMain()
Dim tableFound As Boolean
Dim myTabName As String
'Vérifier qu'un CATDrawing est actif
On Error Resume Next
Set myDrawing = CATIA.ActiveDocument
    If (Err.Number <> 0) Then
        MsgBox ("Un CATDrawing doit être actif")
        Exit Sub
    End If
On Error GoTo 0
If (InStr(myDrawing.Name, ".CATDrawing")) = 0 Then
    MsgBox ("La fenêtre active doit être un CATDrawing")
    Exit Sub
End If

    Set myDrwSheets = myDrawing.Sheets

'Déclare l'application excel
Dim myExcel 'As Excel.Application

'*** Vérifier qu'un XLS est ouvert ***
On Error Resume Next
Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    MsgBox ("Il faut ouvrir le fichier Excel")
    Exit Sub
End If
On Error GoTo 0

Dim myWorkbook 'As Workbook
Set myWorkbook = myExcel.ActiveWorkbook
Set myWorksheet = myWorkbook.ActiveSheet

' **********************************
' ici on peut vérifier si le fichier Excel correspond bien au CATDrawing,
' par exemple en comparant myWorksheet.name et myDrawing.name
' **********************************

'on scanne le fichier Excel pour trouver les différents tableaux, on inscrit le nom, la première et la dernière ligne de chacun.

Dim rowXLS As Integer
Dim rowTab As Integer
rowXLS = 1
rowTab = 0
ReDim xlsTab(0)
'scanne la colonne B jusqu'à qu'il y ait 3 lignes vides:
Do Until (myWorksheet.Cells(rowXLS, 2).Value = "" And myWorksheet.Cells(rowXLS + 1, 2).Value = "" And myWorksheet.Cells(rowXLS + 2, 2).Value = "")
    If rowXLS > 2000 Then
        MsgBox "Erreur de boucle" ' sécurité pour sortir de la boucle
        Exit Sub
    End If
    If myWorksheet.Cells(rowXLS, 2).Value = "POIDS TOTAL" Then
        xlsTab(rowTab).TName = (myWorksheet.Cells(rowXLS - 1, 2).Value)
        xlsTab(rowTab).TFirstRow = rowXLS - 1
    End If
    If myWorksheet.Cells(rowXLS, 2).Value = "N°" Then
        xlsTab(rowTab).TLastRow = rowXLS
        rowTab = rowTab + 1
        ReDim Preserve xlsTab(UBound(xlsTab) + 1)
    End If
    rowXLS = rowXLS + 1
Loop

Call tabSearch

End Sub

'***********************************
' Recherche des tableaux existants
'***********************************
Sub tabSearch()

Dim t As Integer
For t = 0 To UBound(xlsTab) - 1
    myTabName = xlsTab(t).TName
    Dim selection1 As Selection
    Set selection1 = myDrawing.Selection
    selection1.Search "(CAT2DLSearch.DrwTable + CATDrwSearch.DrwTable) & Name= " & myTabName
    If selection1.Count = 0 Then
        selection1.Clear
        selection1.Search "CATDrwSearch.DrwSheet.Name= " & myTabName
        If selection1.Count = 0 Then
            MsgBox " Calque " & myTabName & " non trouvé. Le tableau ne peut pas être créé!", vbCritical
        Else
            rep = MsgBox("Voulez vous créer: " & myTabName & "?", vbYesNo, "Création tableau")
            If rep = vbYes Then
                Call createTab(t)
            End If
        End If
    Else
        rep = MsgBox("Voulez vous mettre à jour: " & myTabName & "?", vbYesNo, "Tableau trouvé")
        If rep = vbYes Then
            Set SelectedElement1 = selection1.Item(1)
            Set myDrawingTable = SelectedElement1.Value
            Call updateTab(t)
        End If
      
    End If
Next
End Sub

'***********************************
' Mise à jour d'un tableau existant
'***********************************
Sub updateTab(table As Integer)

rowTab = 1
For rowXLS = xlsTab(table).TFirstRow To xlsTab(table).TLastRow
        CATIA.Caption = "Ligne : " & rowXLS
        myDrawingTable.SetCellString rowTab, 1, myWorksheet.Cells(rowXLS, 2).Value
        myDrawingTable.SetCellString rowTab, 2, myWorksheet.Cells(rowXLS, 3).Value
        myDrawingTable.SetCellString rowTab, 3, myWorksheet.Cells(rowXLS, 4).Value
        myDrawingTable.SetCellString rowTab, 4, myWorksheet.Cells(rowXLS, 5).Value
        myDrawingTable.SetCellString rowTab, 5, myWorksheet.Cells(rowXLS, 6).Value
        myDrawingTable.SetCellString rowTab, 6, myWorksheet.Cells(rowXLS, 7).Value
        rowTab = rowTab + 1
Next
    
End Sub

'***********************************
' Création d'un nouveau tableau
'***********************************
Sub createTab(table As Integer)
Dim col1 As String
Dim col2 As String
Dim col3 As String
Dim col4 As String
Dim col5 As String
Dim col6 As String
myTabName = xlsTab(table).TName
myDrwSheets.Item(myTabName).Activate 'active le calque portant le même nom que le tableau
Set myDrwView = myDrwSheets.Item(myTabName).Views.Item(2)
myDrwView.Activate
'myDrwSheets.Item(myTabName).Views.Item(2).Activate 'active le calque du fond
Set myDrawingTable = myDrwView.Tables.Add(0#, 0#, 3, 6, 10, 50)
    myDrawingTable.MergeCells 1, 1, 1, 6
    myDrawingTable.Name = myTabName
    myDrawingTable.AnchorPoint = CatTableBottomLeft
    'ligne titre
    myDrawingTable.SetCellString 1, 1, xlsTab(table).TName
    myDrawingTable.SetCellAlignment 1, 1, CatTableMiddleCenter
    'ligne poids total
    myDrawingTable.SetCellString 2, 1, myWorksheet.Cells(xlsTab(table).TFirstRow + 1, 2).Value
    myDrawingTable.SetCellAlignment 2, 1, CatTableMiddleCenter
    myDrawingTable.SetCellString 2, 4, myWorksheet.Cells(xlsTab(table).TFirstRow + 1, 5).Value
    myDrawingTable.SetCellAlignment 2, 4, CatTableMiddleLeft
    myDrawingTable.MergeCells 2, 1, 1, 3
    myDrawingTable.MergeCells 2, 4, 1, 3
    
    'Remplisssage des lignes
    rowtable = 3
For rowXLS = xlsTab(table).TFirstRow + 2 To xlsTab(table).TLastRow
    col1 = myWorksheet.Cells(rowXLS, 2).Value
    col2 = myWorksheet.Cells(rowXLS, 3).Value
    col3 = myWorksheet.Cells(rowXLS, 4).Value
    col4 = myWorksheet.Cells(rowXLS, 5).Value
    col5 = myWorksheet.Cells(rowXLS, 6).Value
    col6 = myWorksheet.Cells(rowXLS, 7).Value
    
    myDrawingTable.AddRow rowtable
    myDrawingTable.SetCellString rowtable, 1, col1
    myDrawingTable.SetCellAlignment rowtable, 1, CatTableMiddleCenter
    myDrawingTable.SetCellString rowtable, 2, col2
    myDrawingTable.SetCellAlignment rowtable, 2, CatTableMiddleLeft
    myDrawingTable.SetCellString rowtable, 3, col3
    myDrawingTable.SetCellAlignment rowtable, 3, CatTableMiddleCenter
    myDrawingTable.SetCellString rowtable, 4, col4
    myDrawingTable.SetCellAlignment rowtable, 4, CatTableMiddleCenter
    myDrawingTable.SetCellString rowtable, 5, col5
    myDrawingTable.SetCellAlignment rowtable, 5, CatTableMiddleCenter
    myDrawingTable.SetCellString rowtable, 6, col6
    myDrawingTable.SetCellAlignment rowtable, 6, CatTableMiddleCenter
    
    rowtable = rowtable + 1
    
Next

myDrawingTable.RemoveRow rowtable
'position du coin inférieur gauche
myDrawingTable.X = 100
myDrawingTable.Y = 20
'Largeur des colonnes
myDrawingTable.SetColumnSize 1, 20
'myDrawingTable.SetColumnSize 2, 0  '0 pour largeur automatique
myDrawingTable.SetColumnSize 2, 100
myDrawingTable.SetColumnSize 3, 20
myDrawingTable.SetColumnSize 4, 20
myDrawingTable.SetColumnSize 5, 40
myDrawingTable.SetColumnSize 6, 100

myDrwSheets.Item(myTabName).Views.Item(1).Activate 'active le calque des vues

End Sub


Salut

Alors deja Woooow merci beaucoup pour l'aide je vais essayer de mettre tout ça en place, je vais aussi essayer de creer un bouton automatisant la MAJ de tous les documents Excel et Catia, du genre ouvrir catia/ mise a jour des doc excel/maj catia

Encore merci

J'ai une dernière question, est-il possible de créer un userform dans mon Excel qui permettrait à quiconque le souhaite d'ajouter la macro automatiquement a son Catia et aussi de mettre à jour le fichiers Excel et les folio Catia du style un panneau qui s'ouvre avec trois choix installer la Macro, MAJ EXCEL-CATIA, etc...

Salut,

A ma connaissance, il n'est pas possible de rajouter automatiquement une macro dans CATIA. Si tu as une installation de CATIA sur réseau, il faut, en mode admin, rajouter la macro pour qu'elle soit disponible pour tous les utilisateurs (CATSettings réseau).
Pour les deux autres boutons, c'est tout à fait possible.

A un moment donné il faut tout de même intervenir sur le PC de l'utilisateur.

Soit tu expliques la procédure pour créer un bouton et l'associer la la macro. (je te conseil de copier la macro sur chaque poste car si elle se trouve sur un lecteur réseau c'est sources d'instabilités, en cas de micro coupure vba part en vrille et il faut relancer la session catia)

Soit en mode administrateur avec le script de pour déployer l'installation catia sur les postes, il faut intégrer la macro (perso je n'ai jamais fait ça je ne suis pas admin des postes)

Salut,

Bon déjà encore merci pour votre aide, j'ai au final crée une bibliothèques a télécharger sur son propre poste pour l'installer dans l'environnement Catia, puis j'ai tout intégré a un User Forms avec plusieurs Onglet pour utiliser différentes dans mon 3D,2D etc. (presque une petite application propre a Catia ahah)

Mais voila quelqu'un a voulu se servir du bouton import et maj tableaux et ca macro bug sur :

Code:

selection1.Search "(CAT2DLSearch.DrwTable + CATDrwSearch.DrwTable) & Name= " & myTabName

Quand il clique sur le bouton celui la lui affiche une erreur : Run-time'error-214767259(80004005)':
Method'Search of object'Selectionfailed

J'ai beau regarder dans tout les sens je ne vois pas d'où peux venir l'erreur, je suppose que cela viens des références mais pourtant toutes les réf. Catia et Excel sont coché