Transfert Nomenclature dans Excel

Bonjour encore une petite macro en cours de réalisation.

Il s'agit cette fois-ci d'automatiser la nomenclature que sort l'outil Nomenclature CATIA dans un fichier Excel.
Pour cela j'ai ce morceau de code qui :
- Enregistre la nomenclature en format excel dans un fichier "BOM_CATIA.xls"
- Ouvre le template nomenclature "Template_BOM.xlt" que j'ai défini et l'enregistre sous "BOM_Excel.xls"
- Colle les éléments voulu du fichier BOM_CATIA vers BOM_EXCEL

Cependant c'est la que ça coince, la fonction Workbooks n'existe pas dans CATIA et je ne peux pas faire la navette entre les 2 fichiers Excel

Quelqu'un a une solution ?

Voici le code :

Code:

'**********************************************************************
' Macro de création d'une nomenclature CATIA 3D pour réalisation dossier consultation
' Charly DUCLOS 01/2018
' CATVBA
'**********************************************************************
Public myExcel As Object
Public myWorksheet As Worksheet

Sub CATMain()

Dim line1 As Integer                    'n°ligne TEMPLATE_BOM
Dim line2 As Integer                    'n°ligne BOM CATIA

Dim myDocument As Document
Set myDocument = CATIA.ActiveDocument

Dim myProduct As Product
Set myProduct = myDocument.Product

Dim assemblyConvertor1 As AssemblyConvertor
Set assemblyConvertor1 = myProduct.GetItem("BillOfMaterial")

Dim arrayOfVariantOfBSTR1(4)
arrayOfVariantOfBSTR1(0) = "Quantité"
arrayOfVariantOfBSTR1(1) = "Référence"
arrayOfVariantOfBSTR1(2) = "Type"
arrayOfVariantOfBSTR1(3) = "Nomenclature"
arrayOfVariantOfBSTR1(4) = "Révision"
Set assemblyConvertor1Variant = assemblyConvertor1
assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR1

Dim arrayOfVariantOfBSTR2(4)
arrayOfVariantOfBSTR2(0) = "Quantité"
arrayOfVariantOfBSTR2(1) = "Référence"
arrayOfVariantOfBSTR2(2) = "Description du produit"
arrayOfVariantOfBSTR2(3) = "MATERIAL"
arrayOfVariantOfBSTR2(4) = "OBSERVATIONS"
Set assemblyConvertor1Variant = assemblyConvertor1
assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR2

Dim assemblyConvertor2 As AssemblyConvertor
Set assemblyConvertor2 = myProduct.GetItem("BillOfMaterial")

Dim arrayOfVariantOfBSTR3(4)
arrayOfVariantOfBSTR3(0) = "Quantité"
arrayOfVariantOfBSTR3(1) = "Référence"
arrayOfVariantOfBSTR3(2) = "Type"
arrayOfVariantOfBSTR3(3) = "Nomenclature"
arrayOfVariantOfBSTR3(4) = "Révision"
Set assemblyConvertor2Variant = assemblyConvertor2
assemblyConvertor2Variant.SetCurrentFormat arrayOfVariantOfBSTR3

Dim arrayOfVariantOfBSTR4(4)
arrayOfVariantOfBSTR4(0) = "Quantité"
arrayOfVariantOfBSTR4(1) = "Référence"
arrayOfVariantOfBSTR4(2) = "Description du produit"
arrayOfVariantOfBSTR4(3) = "MATERIAL"
arrayOfVariantOfBSTR4(4) = "OBSERVATIONS"
Set assemblyConvertor2Variant = assemblyConvertor2
assemblyConvertor2Variant.SetSecondaryFormat arrayOfVariantOfBSTR4

Nom_fichier = myProduct.PartNumber
chemin = "D:\CDU\CAO\MACRO_VBA\"

assemblyConvertor1.[Print] "XLS", chemin & "BOM_CAT_" & Nom_fichier & ".xls", myProduct

'Adressage des fichiers excel
BOM_CATIA = chemin & "BOM_CAT_" & Nom_fichier & ".xls"
BOM_excel = "BOM_" & Nom_fichier & ".xls"
Template_BOM = "\\AITLS-NETAPP01\Y_drive\00_Bibliotheque\00_3D-2D\Macros_Catia\TEMPLATE_MACRO_BOM\TEMPLATE_BOM.xltx"

'Ouverture du template BOM Excel
Set myExcel = CreateObject("Excel.Application")
Set myWorkbook_BOM = myExcel.Workbooks.Open(Template_BOM)
myExcel.Visible = True
Set myWorksheet = myExcel.ActiveSheet
myWorksheet.Name = Nom_fichier
myExcel.ActiveWorkbook.SaveAs chemin & BOM_excel
line1 = 3

'Ouverture de la BOM CATIA Excel
Set myWorkbook_BOM_CATIA = myExcel.Workbooks.Open(BOM_CATIA)
myExcel.Visible = True
line2 = 1

'Passe en revue les lignes pour trouver la première ligne du recap nomenclature
While Left(Sheets("Feuil1").Cells(line2, "A"), 5) <> "Total"
    line2 = line2 + 1
Wend

DEBUT_BOM = line2 + 3               'Début des lignes BOM à copier

Range(Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Sheets("Feuil1").Cells(DEBUT_BOM, "A").End(xlDown)).Copy

Range(Workbooks("BOM_excel").Sheets(Nom_fichier).Cells("A3")).Paste      '''''''''LIGNE QUI BLOQUE

End Sub

Merci pour le coup de main

Bon j'ai résolu le problème avec cette ligne finalement :

Code:

Range(Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Sheets("Feuil1").Cells(DEBUT_BOM, "A").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("A3")

De nouveau bloqué sans trouvé de solution donc je demande de nouveau votre aide.

Le but de la macro est d'extraire la nomenclature 3D via l'outil nomenclature de catia.
De cette nomenclature enregistrée sous un certain nom excel (appelé BOM_CATIA), je demande à la macro de l'ouvrir ainsi que le template enregistré sous un nouveau nom (BOM_excel).
La macro va ensuite rechercher dans BOM_CATIA le début du récapitulatif inscrit dans la variable "DEBUT_BOM".
Enfin, à partir de début BOM, je dois copier les colonnes et les coller dans le fichier BOM_excel.


Cependant, dans mon code je ne comprend pas pourquoi les instructions de copie/colle d'un ensemble de cellule ne fonctionne pas !

Quelqu'un à une idée?

Code:

'**********************************************************************
' Macro de création d'une nomenclature CATIA 3D pour réalisation dossier consultation
' Charly DUCLOS 01/2018
' CATVBA
'**********************************************************************

Sub CATMain()

    Dim myDocument_bom As Document
    Dim myProduct_bom As Product
    Dim myExcel_bom As Object
    Dim myWorksheet_bom As Worksheet
    
'********************************
' Vérifier si le document actif est un CATProduct

    On Error Resume Next
    Set myDocument_bom = 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_bom) <> "ProductDocument" Then
        MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
        End
    End If
    Set myProduct_bom = myDocument_bom.Product
    Nom_fichier = myProduct_bom.PartNumber

'********************************

    Dim X_excel As Integer                    'n°ligne BOM_excel
    Dim X_CATIA As Integer                    'n°ligne BOM_CATIA
    Dim chemin As String

    X_excel = 1
    X_CATIA = 1
    

'********************************
' Bloc de selection du dossier cyble de la nomenclature

'    MsgBox "Veuillez sélectionner le dossier où enregistrer la nomenclature"
'    Set Repertoire_entree = Application.FileDialog(msoFileDialogFolderPicker)
'        Repertoire_entree.Title = "Sélectionner le dossier où enregistrer la nomenclature :"
'        Repertoire_entree.Show
'
'    If Repertoire_entree.SelectedItems.Count > 0 Then
'        Nom_Repertoire_entree = Repertoire_entree.SelectedItems(1)
'    Else
'        MsgBox "Aucun répertoire sélectionné"
'        Exit Sub
'    End If
'    chemin = Nom_Repertoire_entree & "\"





    chemin = "D:\CDU\CAO\MACRO_VBA\NOMENCLATURE\"
    
'*******************************
' Exporter la nomenclature CATIA du CATProduct en session
    
    Dim assemblyConvertor1 As AssemblyConvertor
    Set assemblyConvertor1 = myProduct_bom.GetItem("BillOfMaterial")
    
    Dim arrayOfVariantOfBSTR1(4)
    arrayOfVariantOfBSTR1(0) = "Quantité"
    arrayOfVariantOfBSTR1(1) = "Référence"
    arrayOfVariantOfBSTR1(2) = "Type"
    arrayOfVariantOfBSTR1(3) = "Nomenclature"
    arrayOfVariantOfBSTR1(4) = "Révision"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR1
    
    Dim arrayOfVariantOfBSTR2(4)
    arrayOfVariantOfBSTR2(0) = "Quantité"
    arrayOfVariantOfBSTR2(1) = "Référence"
    arrayOfVariantOfBSTR2(2) = "Description du produit"
    arrayOfVariantOfBSTR2(3) = "MATERIAL"
    arrayOfVariantOfBSTR2(4) = "OBSERVATIONS"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR2
    
    Dim assemblyConvertor2 As AssemblyConvertor
    Set assemblyConvertor2 = myProduct_bom.GetItem("BillOfMaterial")
    
    Dim arrayOfVariantOfBSTR3(4)
    arrayOfVariantOfBSTR3(0) = "Quantité"
    arrayOfVariantOfBSTR3(1) = "Référence"
    arrayOfVariantOfBSTR3(2) = "Type"
    arrayOfVariantOfBSTR3(3) = "Nomenclature"
    arrayOfVariantOfBSTR3(4) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetCurrentFormat arrayOfVariantOfBSTR3
    
    Dim arrayOfVariantOfBSTR4(6)
    arrayOfVariantOfBSTR4(0) = "Quantité"
    arrayOfVariantOfBSTR4(1) = "Référence"
    arrayOfVariantOfBSTR4(2) = "Description du produit"
    arrayOfVariantOfBSTR4(3) = "MATERIAL"
    arrayOfVariantOfBSTR4(4) = "OBSERVATIONS"
    arrayOfVariantOfBSTR4(5) = "Source"
    arrayOfVariantOfBSTR4(6) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetSecondaryFormat arrayOfVariantOfBSTR4
    assemblyConvertor1.[Print] "XLS", chemin & "BOM_CAT_" & Nom_fichier & ".xlsx", myProduct_bom
    
'*******************************
' Travail de traitement de texte dans les fichiers Excel nomenclatures
'*******************************
' Adressage des fichiers excel

    BOM_CATIA = "BOM_CAT_" & Nom_fichier & ".xlsx"
    BOM_excel = "BOM_" & Nom_fichier & ".xlsx"
    chBOM_CATIA = chemin & BOM_CATIA
    chBOM_excel = chemin & BOM_excel
    chTemplate_BOM = "Y_drive\00_Bibliotheque\00_3D-2D\Macros_Catia\TEMPLATE_MACRO_BOM\TEMPLATE_BOM.xltx"   ''Template nomenclature sur le réseau
    
'Ouverture du fichier BOM CATIA
    Set myExcel_bom = CreateObject("Excel.Application")
    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chBOM_CATIA)
    myExcel_bom.Visible = True
    Set myWorksheet_bom = myExcel_bom.ActiveSheet
          
'Ouverture du template BOM Excel et sauvegarde sous "Nom fichier"
    Set myExcel_bom = CreateObject("Excel.Application")
    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chTemplate_BOM)
    myExcel_bom.Visible = True
    Set myWorksheet_bom = myExcel_bom.ActiveSheet
    myWorksheet_bom.Name = Nom_fichier
    myExcel_bom.ActiveWorkbook.SaveAs chBOM_excel
  
'*******************************
'Passe en revue les lignes pour trouver la première ligne du recap nomenclature
    
    Workbooks(BOM_CATIA).Activate
    
    While Left(Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(X_CATIA, "A"), 5) <> "Total"
        X_CATIA = X_CATIA + 1
    Wend
    DEBUT_BOM = X_CATIA + 3               'Début des lignes BOM à copier
    
    Workbooks(BOM_CATIA).Activate
'Copie de la colonne Quantité
    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Sheets("Feuil1").Cells(DEBUT_BOM, "A").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("A3")
    
'Copie de la colonne Part Number
    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "B"), Sheets("Feuil1").Cells(DEBUT_BOM, "B").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("B3")
    
'Copie de la colonne Article
    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "C"), Sheets("Feuil1").Cells(DEBUT_BOM, "C").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("C3")
    
'Copie de la colonne Material
    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "D"), Sheets("Feuil1").Cells(DEBUT_BOM, "D").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("K3")
    
'Copie de la colonne Observation
    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "E"), Sheets("Feuil1").Cells(DEBUT_BOM, "E").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("L3")
    
'Copie de la colonne Source
    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "F"), Sheets("Feuil1").Cells(DEBUT_BOM, "F").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("J3")

'Detection de la nature des pièces
    Workbooks(BOM_excel).Activate
    
    While Sheets(Nom_fichier).Cells(X_excel, "A") <> ""
        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Fabriqué" Then
            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "REALISATION"
        End If
        
        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Made" Then
            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "REALISATION"
        End If
        
        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Acheté" Then
            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "CHOISIR"
        End If
                
        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Bought" Then
            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "CHOISIR"
        End If
    
        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Inconnu" Then
            Sheets(Nom_fichier).Cells(X_excel, "I").Value = ""
        End If
        
        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Unknown" Then
            Sheets(Nom_fichier).Cells(X_excel, "I").Value = ""
        End If
        X_excel = X_excel + 1
    Wend
    
    X_excel = 3
    While Sheets(Nom_fichier).Cells(line1, "A") <> ""
        If Left(Sheets(Nom_fichier).Cells(line1, "B").Value, 3) = "JTT" Then
            Sheets(Nom_fichier).Cells(line1, "I").Value = "VISSERIE"
        End If
        X_excel = X_excel + 1
    Wend
    
' Cacher la colonne SOURCE
    Columns("J").Select
    Selection.EntireColumn.Hidden = True

' Enregistrer le classeur
    'Workbooks(BOM_excel).Save '
    
End Sub



J'ai l'impression qu'il zappe complètement les lignes Workbooks(blablabla).Activate qui sont censé définir le classeur excel actif non ?

Merci de votre aide

Salut Charly,

Essaie sans activer le Workbook mais en écrivant "l'adresse" de façon explicite:

Code:

   
'Copie de la colonne Quantité
    Workbooks(BOM_CATIA).Range(Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Sheets("Feuil1").Cells(DEBUT_BOM, "A").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("A3")

Salut Marc,

non ça ne fonctionne pas non plus.
De mon coté j'ai essayé de passer par un tableau virtuel en pensant que copier de excel vers le tableau plus du tableau vers excel fonctionnerait mais ce n'est pas le cas non plus.

Voici le code

Code:

'**********************************************************************
' Macro de création d'une nomenclature CATIA 3D pour réalisation dossier consultation
' Charly DUCLOS 01/2018
' CATVBA
'**********************************************************************

Sub CATMain()

    Dim myDocument_bom As Document
    Dim myProduct_bom As Product
    Dim myExcel_bom As Object
    Dim myWorksheet_bom As Worksheet
   
'********************************
' Vérifier si le document actif est un CATProduct

    On Error Resume Next
    Set myDocument_bom = 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_bom) <> "ProductDocument" Then
        MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
        End
    End If
    Set myProduct_bom = myDocument_bom.Product
    Nom_fichier = myProduct_bom.PartNumber

'********************************

    Dim X_excel As Integer                    'n°ligne BOM_excel
    Dim Y_excel As Integer                    'n°colonne BOM_excel
    Dim X_CATIA As Integer                    'n°ligne BOM_CATIA
    Dim chemin As String

    X_excel = 3
    Y_excel = 1
    X_CATIA = 1
   

'********************************
' Bloc de selection du dossier cyble de la nomenclature

'    MsgBox "Veuillez sélectionner le dossier où enregistrer la nomenclature"
'    Set Repertoire_entree = Application.FileDialog(msoFileDialogFolderPicker)
'        Repertoire_entree.Title = "Sélectionner le dossier où enregistrer la nomenclature :"
'        Repertoire_entree.Show
'
'    If Repertoire_entree.SelectedItems.Count > 0 Then
'        Nom_Repertoire_entree = Repertoire_entree.SelectedItems(1)
'    Else
'        MsgBox "Aucun répertoire sélectionné"
'        Exit Sub
'    End If
'    chemin = Nom_Repertoire_entree & "\"





    chemin = "D:\CDU\CAO\MACRO_VBA\NOMENCLATURE\"
   
'*******************************
' Exporter la nomenclature CATIA du CATProduct en session
   
    Dim assemblyConvertor1 As AssemblyConvertor
    Set assemblyConvertor1 = myProduct_bom.GetItem("BillOfMaterial")
   
    Dim arrayOfVariantOfBSTR1(4)
    arrayOfVariantOfBSTR1(0) = "Quantité"
    arrayOfVariantOfBSTR1(1) = "Référence"
    arrayOfVariantOfBSTR1(2) = "Type"
    arrayOfVariantOfBSTR1(3) = "Nomenclature"
    arrayOfVariantOfBSTR1(4) = "Révision"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR1
   
    Dim arrayOfVariantOfBSTR2(4)
    arrayOfVariantOfBSTR2(0) = "Quantité"
    arrayOfVariantOfBSTR2(1) = "Référence"
    arrayOfVariantOfBSTR2(2) = "Description du produit"
    arrayOfVariantOfBSTR2(3) = "MATERIAL"
    arrayOfVariantOfBSTR2(4) = "OBSERVATIONS"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR2
   
    Dim assemblyConvertor2 As AssemblyConvertor
    Set assemblyConvertor2 = myProduct_bom.GetItem("BillOfMaterial")
   
    Dim arrayOfVariantOfBSTR3(4)
    arrayOfVariantOfBSTR3(0) = "Quantité"
    arrayOfVariantOfBSTR3(1) = "Référence"
    arrayOfVariantOfBSTR3(2) = "Type"
    arrayOfVariantOfBSTR3(3) = "Nomenclature"
    arrayOfVariantOfBSTR3(4) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetCurrentFormat arrayOfVariantOfBSTR3
   
    Dim arrayOfVariantOfBSTR4(6)
    arrayOfVariantOfBSTR4(0) = "Quantité"
    arrayOfVariantOfBSTR4(1) = "Référence"
    arrayOfVariantOfBSTR4(2) = "Description du produit"
    arrayOfVariantOfBSTR4(3) = "MATERIAL"
    arrayOfVariantOfBSTR4(4) = "OBSERVATIONS"
    arrayOfVariantOfBSTR4(5) = "Source"
    arrayOfVariantOfBSTR4(6) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetSecondaryFormat arrayOfVariantOfBSTR4
    assemblyConvertor1.[Print] "XLS", chemin & "BOM_CAT_" & Nom_fichier & ".xlsx", myProduct_bom
   
'*******************************
' Travail de traitement de texte dans les fichiers Excel nomenclatures
'*******************************
' Adressage des fichiers excel

    BOM_CATIA = "BOM_CAT_" & Nom_fichier & ".xlsx"
    BOM_excel = "BOM_" & Nom_fichier & ".xlsx"
    chBOM_CATIA = chemin & BOM_CATIA
    chBOM_excel = chemin & BOM_excel
    chTemplate_BOM = "\\AITLS-NETAPP01\Y_drive\00_Bibliotheque\00_3D-2D\Macros_Catia\TEMPLATE_MACRO_BOM\TEMPLATE_BOM.xltx"  ''Template nomenclature sur le réseau
   
'Ouverture du fichier BOM CATIA
    Set myExcel_bom = CreateObject("Excel.Application")
    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chBOM_CATIA)
    myExcel_bom.Visible = True
    Set myWorksheet_bom = myExcel_bom.ActiveSheet

'Ouverture du template BOM Excel et sauvegarde sous "Nom fichier"
    Set myExcel_bom = CreateObject("Excel.Application")
    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chTemplate_BOM)
    myExcel_bom.Visible = True
    Set myWorksheet_bom = myExcel_bom.ActiveSheet
    myWorksheet_bom.Name = Nom_fichier
    myExcel_bom.ActiveWorkbook.SaveAs chBOM_excel

'*******************************
'Passe en revue les lignes pour trouver la première ligne du recap nomenclature
   
    Workbooks(BOM_CATIA).Activate
   
    While Left(Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(X_CATIA, "A"), 5) <> "Total"
        X_CATIA = X_CATIA + 1
    Wend
    DEBUT_BOM = X_CATIA + 3              'Début des lignes BOM à copier

'*******************************
'Création d'une table virtuelle pour transfert des données
' Colonne = Quantité // PART Name // Description // Matière // Observation // Source // Révision = 7
' Ligne = nb de pièces

    X_table = X_CATIA + 3
    Y_table = 1
   
    While Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(X_table, "A") <> ""
        X_table = X_table + 1
    Wend
    FIN_BOM = X_table - 1
     
    Dim Table_Transfert() As Variant
    Table_Transfert = Range(Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(FIN_BOM, "G"))
    Nb_ligne_table = UBound(Table_Transfert)
     
' Transfert des données vers BOM_excel
   
    For i = 1 To Nb_ligne_table
        Sheets(Nom_fichier).Cells(X_excel, "A").Value = Table_Transfert(i, Y_table)
       
       
    Next i
   
   
   
   
   
'
''Copie de la colonne Quantité
'    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Sheets("Feuil1").Cells(DEBUT_BOM, "A").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("A3")
'
''Copie de la colonne Part Number
'    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "B"), Sheets("Feuil1").Cells(DEBUT_BOM, "B").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("B3")
'
''Copie de la colonne Article
'    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "C"), Sheets("Feuil1").Cells(DEBUT_BOM, "C").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("C3")
'
''Copie de la colonne Material
'    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "D"), Sheets("Feuil1").Cells(DEBUT_BOM, "D").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("K3")
'
''Copie de la colonne Observation
'    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "E"), Sheets("Feuil1").Cells(DEBUT_BOM, "E").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("L3")
'
''Copie de la colonne Source
'    Range(Sheets("Feuil1").Cells(DEBUT_BOM, "F"), Sheets("Feuil1").Cells(DEBUT_BOM, "F").End(xlDown)).Copy Workbooks(BOM_excel).Sheets(Nom_fichier).Range("J3")
'
''Detection de la nature des pièces
'    Workbooks(BOM_excel).Activate
'
'    While Sheets(Nom_fichier).Cells(X_excel, "A") <> ""
'        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Fabriqué" Then
'            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "REALISATION"
'        End If
'
'        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Made" Then
'            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "REALISATION"
'        End If
'
'        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Acheté" Then
'            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "CHOISIR"
'        End If
'
'        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Bought" Then
'            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "CHOISIR"
'        End If
'
'        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Inconnu" Then
'            Sheets(Nom_fichier).Cells(X_excel, "I").Value = ""
'        End If
'
'        If Sheets(Nom_fichier).Cells(X_excel, "J").Value = "Unknown" Then
'            Sheets(Nom_fichier).Cells(X_excel, "I").Value = ""
'        End If
'        X_excel = X_excel + 1
'    Wend
'
'    X_excel = 3
'    While Sheets(Nom_fichier).Cells(line1, "A") <> ""
'        If Left(Sheets(Nom_fichier).Cells(X_excel, "B").Value, 3) = "JTT" Then
'            Sheets(Nom_fichier).Cells(X_excel, "I").Value = "VISSERIE"
'        End If
'        X_excel = X_excel + 1
'    Wend
'
'' Cacher la colonne SOURCE
'    Columns("J").Select
'    Selection.EntireColumn.Hidden = True
'
'' Enregistrer le classeur
'    'Workbooks(BOM_excel).Save '
   
End Sub



Tout se copie correctement dans le tableau mais ensuite c'est comme si le deuxième classeur excel n'existait pas !

Salut Charly,

remplace
Sheets(Nom_fichier).Cells(X_excel, "A").Value = Table_Transfert(i, Y_table)
par
myWorksheet_bom.Cells(X_excel, "A").Value = Table_Transfert(i, Y_table)

Mais dans ta boucle X_excel n'évolue pas, tu écris donc toujours dans la cellule A1.

Tu devrais aussi différencier tes noms de variable (myWorkbook_bom et myWorksheet_bom) pour tes 2 tableaux Excel ((chBOM_CATIA et chBOM_excel).

Salut Marc,

j'ai réussi à m'en sortir avec le code finale suivant :

Code:

'**********************************************************************
' Macro de création d'une nomenclature CATIA 3D pour réalisation dossier consultation
' Charly DUCLOS 01/2018
' CATVBA
'**********************************************************************

Sub CATMain()

    Dim myDocument_bom As Document
    Dim myProduct_bom As Product
    Dim myExcel_bom As Object
    Dim myWorksheet_bom As Worksheet
    Dim myWorkbook_bom As Workbook
    Dim myExcel_bom2 As Object
    Dim myWorksheet_bom2 As Worksheet
    Dim myWorkbook_bom2 As Workbook
    
'********************************
' Vérifier si le document actif est un CATProduct

    On Error Resume Next
    Set myDocument_bom = 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_bom) <> "ProductDocument" Then
        MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
        End
    End If
    Set myProduct_bom = myDocument_bom.Product
    Nom_fichier = myProduct_bom.PartNumber

'********************************

    Dim X_excel As Integer                    'n°ligne BOM_excel
    Dim Y_excel As Integer                    'n°colonne BOM_excel
    Dim X_CATIA As Integer                    'n°ligne BOM_CATIA
    Dim Chemin As String

    X_excel = 3
    Y_excel = 1
    X_CATIA = 1
    
'********************************
' Bloc de selection du dossier cible de la nomenclature
'
'    MsgBox "Veuillez sélectionner le dossier où enregistrer la nomenclature"
'    Set Repertoire_entree = Application.FileDialog(msoFileDialogFolderPicker)
'        Repertoire_entree.Title = "Sélectionner le dossier où enregistrer la nomenclature :"
'        Repertoire_entree.Show
'
'    If Repertoire_entree.SelectedItems.Count > 0 Then
'        Nom_Repertoire_entree = Repertoire_entree.SelectedItems(1)
'    Else
'        MsgBox "Aucun répertoire sélectionné"
'        Exit Sub
'    End If
'    Chemin = Nom_Repertoire_entree & "\"





    Chemin = "D:\CDU\CAO\MACRO_VBA\NOMENCLATURE\"
    
'*******************************
' Exporter la nomenclature CATIA du CATProduct en session
    
    Dim assemblyConvertor1 As AssemblyConvertor
    Set assemblyConvertor1 = myProduct_bom.GetItem("BillOfMaterial")
    
    Dim arrayOfVariantOfBSTR1(4)
    arrayOfVariantOfBSTR1(0) = "Quantité"
    arrayOfVariantOfBSTR1(1) = "Référence"
    arrayOfVariantOfBSTR1(2) = "Type"
    arrayOfVariantOfBSTR1(3) = "Nomenclature"
    arrayOfVariantOfBSTR1(4) = "Révision"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR1
    
    Dim arrayOfVariantOfBSTR2(4)
    arrayOfVariantOfBSTR2(0) = "Quantité"
    arrayOfVariantOfBSTR2(1) = "Référence"
    arrayOfVariantOfBSTR2(2) = "Description du produit"
    arrayOfVariantOfBSTR2(3) = "MATERIAL"
    arrayOfVariantOfBSTR2(4) = "OBSERVATIONS"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR2
    
    Dim assemblyConvertor2 As AssemblyConvertor
    Set assemblyConvertor2 = myProduct_bom.GetItem("BillOfMaterial")
    
    Dim arrayOfVariantOfBSTR3(4)
    arrayOfVariantOfBSTR3(0) = "Quantité"
    arrayOfVariantOfBSTR3(1) = "Référence"
    arrayOfVariantOfBSTR3(2) = "Type"
    arrayOfVariantOfBSTR3(3) = "Nomenclature"
    arrayOfVariantOfBSTR3(4) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetCurrentFormat arrayOfVariantOfBSTR3
    
    Dim arrayOfVariantOfBSTR4(6)
    arrayOfVariantOfBSTR4(0) = "Quantité"
    arrayOfVariantOfBSTR4(1) = "Référence"
    arrayOfVariantOfBSTR4(2) = "Description du produit"
    arrayOfVariantOfBSTR4(3) = "MATERIAL"
    arrayOfVariantOfBSTR4(4) = "OBSERVATIONS"
    arrayOfVariantOfBSTR4(5) = "Source"
    arrayOfVariantOfBSTR4(6) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetSecondaryFormat arrayOfVariantOfBSTR4
    assemblyConvertor1.[Print] "XLS", Chemin & "BOM_CAT_" & Nom_fichier & ".xlsx", myProduct_bom
    

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

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

    
    
'*******************************
' Travail de traitement de texte dans les fichiers Excel nomenclatures
'*******************************
' Adressage des fichiers excel

    BOM_CATIA = "BOM_CAT_" & Nom_fichier & ".xlsx"
    BOM_excel = "BOM_" & Nom_fichier & ".xlsx"
    chBOM_CATIA = Chemin & BOM_CATIA
    chBOM_excel = Chemin & BOM_excel
    chTemplate_BOM = "\\AITLS-NETAPP01\Y_drive\00_Bibliotheque\00_3D-2D\Macros_Catia\TEMPLATE_MACRO_BOM\TEMPLATE_BOM.xltx"   ''Template nomenclature sur le réseau

'Ouverture du fichier BOM CATIA

    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chBOM_CATIA)
    Application.ScreenUpdating = False
    
'*******************************
'Passe en revue les lignes pour trouver la première ligne du recap nomenclature
    
    Workbooks(BOM_CATIA).Activate
    
    While Left(Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(X_CATIA, "A"), 5) <> "Total"
        X_CATIA = X_CATIA + 1
    Wend
    DEBUT_BOM = X_CATIA + 3               'Début des lignes BOM à copier

'*******************************
' Création d'une table virtuelle pour transfert des données
' Colonne = Quantité // PART Name // Description // Matière // Observation // Source // Révision = 7
' Ligne = nb de pièces

    X_table = X_CATIA + 3
    Y_table = 1
    
    While Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(X_table, "A") <> ""
        X_table = X_table + 1
    Wend
    FIN_BOM = X_table - 1
      
    Dim Table_Transfert() As Variant
    Table_Transfert = Range(Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(FIN_BOM, "G"))
    Nb_ligne_table = UBound(Table_Transfert)
      
    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chTemplate_BOM)
    Set myWorksheet_bom2 = myExcel_bom.ActiveSheet
    myWorksheet_bom2.Name = Nom_fichier
    myExcel_bom.ActiveWorkbook.SaveAs chBOM_excel

' Transfert des données vers BOM_excel
    
    For i = 1 To Nb_ligne_table
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "A").Value = Table_Transfert(i, Y_table)        'ligne quantité
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "B").Value = Table_Transfert(i, Y_table + 1)    'ligne Part Name
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "C").Value = Table_Transfert(i, Y_table + 2)    'ligne Description
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "L").Value = Table_Transfert(i, Y_table + 3)    'ligne Matière
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "M").Value = Table_Transfert(i, Y_table + 4)    'ligne Observation
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "K").Value = Table_Transfert(i, Y_table + 5)    'ligne Source
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "D").Value = Table_Transfert(i, Y_table + 6)    'ligne Revision
        
        X_excel = X_excel + 1
    Next i

'Detection de la nature des pièces
    Workbooks(BOM_excel).Activate
    X_excel = 3
    
    While Sheets(Nom_fichier).Cells(X_excel, "A") <> ""
        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Fabriqué" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "REALISATION"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Made" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "REALISATION"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Acheté" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "CHOISIR"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Bought" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "CHOISIR"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Inconnu" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = ""
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Unknown" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = ""
        End If
        X_excel = X_excel + 1
    Wend

    X_excel = 3
    While Sheets(Nom_fichier).Cells(X_excel, "A") <> ""
        If Left(Sheets(Nom_fichier).Cells(X_excel, "B").Value, 3) = "JTT" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "VISSERIE"
        End If
        X_excel = X_excel + 1
    Wend

' Cacher la colonne SOURCE
    Columns("K").Select
    Selection.EntireColumn.Hidden = True
    Application.ScreenUpdating = True

' Enregistrer le classeur
    Workbooks(BOM_excel).Save
    Workbooks(BOM_CATIA).Close
    
End Sub


Cependant, toujours dans un soucis d'amélioration, j'ai voulu me donner la possibilité de choisir par moi-même le dossier où enregistrer la macro avec l'ouverture d'une boite de dialogue Windows. Je suis passer par la fonction SelectDossier que j'ai déjà utilisé ailleurs.

Le Chemin se sélectionne bien mais par contre plus possible de passer dans Excel pour faire le traitement des lignes, une erreur "9" s'affiche :


Je ne comprend pas pourquoi cela bloque à l'instruction : Workbooks(BOM_CATIA).Activate
Alors que les nomenclatures sont bien enregistrer au bon endroit, elles s'ouvrent également dans Excel mais impossible de travailler dessus!
Les deux variables "chemin" sont des string quelques soit la façon de les acquérrir !

Code:

'**********************************************************************
' Macro de création d'une nomenclature CATIA 3D pour réalisation dossier consultation
' Charly DUCLOS 01/2018
' CATVBA
'**********************************************************************

Sub CATMain()

    Dim myDocument_bom As Document
    Dim myProduct_bom As Product
    Dim myExcel_bom As Object
    Dim myWorksheet_bom As Worksheet
    Dim myWorkbook_bom As Workbook
    Dim myExcel_bom2 As Object
    Dim myWorksheet_bom2 As Worksheet
    Dim myWorkbook_bom2 As Workbook
    
'********************************
' Vérifier si le document actif est un CATProduct

    On Error Resume Next
    Set myDocument_bom = 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_bom) <> "ProductDocument" Then
        MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
        End
    End If
    Set myProduct_bom = myDocument_bom.Product
    Nom_fichier = myProduct_bom.PartNumber

'********************************

    Dim X_excel As Integer                    'n°ligne BOM_excel
    Dim Y_excel As Integer                    'n°colonne BOM_excel
    Dim X_CATIA As Integer                    'n°ligne BOM_CATIA
    'Dim Chemin As String

    X_excel = 3
    Y_excel = 1
    X_CATIA = 1
    
'********************************
' Bloc de selection du dossier cible de la nomenclature
'*************
Dim Chemin$
    Chemin = SelectDossier
    If Chemin <> "" Then MsgBox "Vous avez sélectionné :" & vbCrLf & Chemin

    Chemin = Chemin & "\"


'    chemin = "D:\CDU\CAO\MACRO_VBA\NOMENCLATURE\"
    
'*******************************
' Exporter la nomenclature CATIA du CATProduct en session
    
    Dim assemblyConvertor1 As AssemblyConvertor
    Set assemblyConvertor1 = myProduct_bom.GetItem("BillOfMaterial")
    
    Dim arrayOfVariantOfBSTR1(4)
    arrayOfVariantOfBSTR1(0) = "Quantité"
    arrayOfVariantOfBSTR1(1) = "Référence"
    arrayOfVariantOfBSTR1(2) = "Type"
    arrayOfVariantOfBSTR1(3) = "Nomenclature"
    arrayOfVariantOfBSTR1(4) = "Révision"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR1
    
    Dim arrayOfVariantOfBSTR2(4)
    arrayOfVariantOfBSTR2(0) = "Quantité"
    arrayOfVariantOfBSTR2(1) = "Référence"
    arrayOfVariantOfBSTR2(2) = "Description du produit"
    arrayOfVariantOfBSTR2(3) = "MATERIAL"
    arrayOfVariantOfBSTR2(4) = "OBSERVATIONS"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR2
    
    Dim assemblyConvertor2 As AssemblyConvertor
    Set assemblyConvertor2 = myProduct_bom.GetItem("BillOfMaterial")
    
    Dim arrayOfVariantOfBSTR3(4)
    arrayOfVariantOfBSTR3(0) = "Quantité"
    arrayOfVariantOfBSTR3(1) = "Référence"
    arrayOfVariantOfBSTR3(2) = "Type"
    arrayOfVariantOfBSTR3(3) = "Nomenclature"
    arrayOfVariantOfBSTR3(4) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetCurrentFormat arrayOfVariantOfBSTR3
    
    Dim arrayOfVariantOfBSTR4(6)
    arrayOfVariantOfBSTR4(0) = "Quantité"
    arrayOfVariantOfBSTR4(1) = "Référence"
    arrayOfVariantOfBSTR4(2) = "Description du produit"
    arrayOfVariantOfBSTR4(3) = "MATERIAL"
    arrayOfVariantOfBSTR4(4) = "OBSERVATIONS"
    arrayOfVariantOfBSTR4(5) = "Source"
    arrayOfVariantOfBSTR4(6) = "Révision"
    Set assemblyConvertor2Variant = assemblyConvertor2
    assemblyConvertor2Variant.SetSecondaryFormat arrayOfVariantOfBSTR4
    assemblyConvertor1.[Print] "XLS", Chemin & "BOM_CAT_" & Nom_fichier & ".xlsx", myProduct_bom
    

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

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

    
    
'*******************************
' Travail de traitement de texte dans les fichiers Excel nomenclatures
'*******************************
' Adressage des fichiers excel

    BOM_CATIA = "BOM_CAT_" & Nom_fichier & ".xlsx"
    BOM_excel = "BOM_" & Nom_fichier & ".xlsx"
    chBOM_CATIA = Chemin & BOM_CATIA
    chBOM_excel = Chemin & BOM_excel
    chTemplate_BOM = "\\AITLS-NETAPP01\Y_drive\00_Bibliotheque\00_3D-2D\Macros_Catia\TEMPLATE_MACRO_BOM\TEMPLATE_BOM.xltx"   ''Template nomenclature sur le réseau
    
'Ouverture du fichier BOM CATIA
'    Set myExcel_bom = CreateObject("Excel.Application")
'    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chBOM_CATIA)
'    myExcel_bom.Visible = True
'    Set myWorksheet_bom = myExcel_bom.ActiveSheet
    
    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chBOM_CATIA)
    'Set myWorkbook_bom = myExcel_bom.Workbooks.Add
   ''Set myWorksheet_bom = myExcel_bom.Sheets.Add
   ''myWorksheet_bom.Name = Nom_fichier '"Export"

''Ouverture du template BOM Excel et sauvegarde sous "Nom fichier"
'    Set myExcel_bom2 = CreateObject("Excel.Application")
'    Set myWorkbook_bom2 = myExcel_bom2.Workbooks.Open(chTemplate_BOM)
'    myExcel_bom2.Visible = True
'    Set myWorksheet_bom2 = myExcel_bom2.ActiveSheet
'    myWorksheet_bom2.Name = Nom_fichier
'    myExcel_bom2.ActiveWorkbook.SaveAs chBOM_excel

'*******************************
'Passe en revue les lignes pour trouver la première ligne du recap nomenclature
    
    Workbooks(BOM_CATIA).Activate
    
    While Left(Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(X_CATIA, "A"), 5) <> "Total"
        X_CATIA = X_CATIA + 1
    Wend
    DEBUT_BOM = X_CATIA + 3               'Début des lignes BOM à copier

'*******************************
'Création d'une table virtuelle pour transfert des données
' Colonne = Quantité // PART Name // Description // Matière // Observation // Source // Révision = 7
' Ligne = nb de pièces

    X_table = X_CATIA + 3
    Y_table = 1
    
    While Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(X_table, "A") <> ""
        X_table = X_table + 1
    Wend
    FIN_BOM = X_table - 1
      
    Dim Table_Transfert() As Variant
    Table_Transfert = Range(Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(DEBUT_BOM, "A"), Workbooks(BOM_CATIA).Sheets("Feuil1").Cells(FIN_BOM, "G"))
    Nb_ligne_table = UBound(Table_Transfert)
      
    Set myWorkbook_bom = myExcel_bom.Workbooks.Open(chTemplate_BOM)
    Set myWorksheet_bom2 = myExcel_bom.ActiveSheet
    myWorksheet_bom2.Name = Nom_fichier
    myExcel_bom.ActiveWorkbook.SaveAs chBOM_excel



' Transfert des données vers BOM_excel
    
    For i = 1 To Nb_ligne_table
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "A").Value = Table_Transfert(i, Y_table)        'ligne quantité
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "B").Value = Table_Transfert(i, Y_table + 1)    'ligne Part Name
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "C").Value = Table_Transfert(i, Y_table + 2)    'ligne Description
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "L").Value = Table_Transfert(i, Y_table + 3)    'ligne Matière
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "M").Value = Table_Transfert(i, Y_table + 4)    'ligne Observation
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "K").Value = Table_Transfert(i, Y_table + 5)    'ligne Source
        Workbooks(BOM_excel).Sheets(Nom_fichier).Cells(X_excel, "D").Value = Table_Transfert(i, Y_table + 6)    'ligne Revision
        
        X_excel = X_excel + 1
    Next i

'Detection de la nature des pièces
    Workbooks(BOM_excel).Activate
    X_excel = 3
    
    While Sheets(Nom_fichier).Cells(X_excel, "A") <> ""
        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Fabriqué" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "REALISATION"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Made" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "REALISATION"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Acheté" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "CHOISIR"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Bought" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "CHOISIR"
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Inconnu" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = ""
        End If

        If Sheets(Nom_fichier).Cells(X_excel, "K").Value = "Unknown" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = ""
        End If
        X_excel = X_excel + 1
    Wend

    X_excel = 3
    While Sheets(Nom_fichier).Cells(X_excel, "A") <> ""
        If Left(Sheets(Nom_fichier).Cells(X_excel, "B").Value, 3) = "JTT" Then
            Sheets(Nom_fichier).Cells(X_excel, "J").Value = "VISSERIE"
        End If
        X_excel = X_excel + 1
    Wend

' Cacher la colonne SOURCE
    Columns("K").Select
    Selection.EntireColumn.Hidden = True

' Enregistrer le classeur
    'Workbooks(BOM_excel).Save '
    
End Sub

Function SelectDossier$(Optional Titre$ = "Choisissez le dossier d'enregistrement et cliquez sur le bouton ""Choix Dossier""")
'myDearFriend! - www.mdf-xlpages.com
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Choix Dossier"
        '.InitialFileName = ThisWorkbook.Path & "\"
        .Title = Titre
        .Show
        If .SelectedItems.Count > 0 Then
            SelectDossier = .SelectedItems(1)
        End If
    End With
End Function



Je crois que j'arrive aux limites de mes compétences actuelles

Salut Charly,

Je ne sais pas pourquoi mais le problème vient de ta fonction de sélection du dossier.
Je t'en propose donc une autre qui d'après mes tests fonctionne. Cette fonction ne nécessite pas d'activer les références "Microsoft Office xx Object Library"

Code:

Function SelectDossier$(Optional Titre$ = "Choisissez le dossier d'enregistrement et cliquez sur le bouton ""Choix Dossier""")

'NEW :
 
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionner le répertoire destination", ssfTous)
    If objFolder Is Nothing Then Exit Function
    Set oFolderItem = objFolder.Items.Item
   
    SelectDossier = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing

'OLD:
'myDearFriend! - www.mdf-xlpages.com
'    With Application.FileDialog(msoFileDialogFolderPicker)
'        .ButtonName = "Choix Dossier"
        '.InitialFileName = ThisWorkbook.Path & "\"
'        .Title = Titre
'        .Show
'        If .SelectedItems.Count > 0 Then
'            SelectDossier = .SelectedItems(1)
'        End If
'    End With
   
End Function

Bonjour Marc,

merci pour ton aide.
Effectivement ceci fonctionne mais je ne la trouve pas pratique du coup je ne l'avais pas testé avant.
Au moins la macro est fonctionnelle avec ceci et je t'en remercie.
Qui sait, peut-etre que je trouverais la réponse dans quelques mois.

Charly

Salut
CharlyDuclos j'ai l'impressiont que l'objet Workbooks n'est pas défini dans ton code

il devrait y avoir un truc dans le genre

set Workbooks = myExcel_bom.Workbooks()

dans les lignes situées avant

Workbooks(BOM_CATIA).Activate

Ensuite si tu as un "out of range" c'est que la variable BOM_CATIA contient une info qui n'es pas cohérente et désignerait un classeur qui n'existe pas dans le fichier excel ouvert. (soit le fichier est le mauvais soit la destination du classeur est erronée)

C'est comme ça que j'investiguerais