Transfert Nomenclature dans Excel

Voir le sujet précédent Voir le sujet suivant Aller en bas

Transfert Nomenclature dans Excel

Message par CharlyDuclos le Jeu 11 Jan 2018 - 1:55

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 Crying or Very sad

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

CharlyDuclos
timide
timide

Messages : 19
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Transfert Nomenclature dans Excel

Message par CharlyDuclos le Jeu 11 Jan 2018 - 22:22

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")

CharlyDuclos
timide
timide

Messages : 19
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Transfert Nomenclature dans Excel

Message par CharlyDuclos Hier à 3:31

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 'QuestionQuestion
    
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

CharlyDuclos
timide
timide

Messages : 19
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Transfert Nomenclature dans Excel

Message par lumpazepfel Hier à 20:22

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")
avatar
lumpazepfel
actif
actif

Messages : 157
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Transfert Nomenclature dans Excel

Message par CharlyDuclos Hier à 20:51

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 'QuestionQuestion
   
End Sub


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

CharlyDuclos
timide
timide

Messages : 19
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Transfert Nomenclature dans Excel

Message par lumpazepfel Aujourd'hui à 1:20

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).
avatar
lumpazepfel
actif
actif

Messages : 157
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Transfert Nomenclature dans Excel

Message par CharlyDuclos Aujourd'hui à 3:26

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 'QuestionQuestion
    
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 Exclamation

CharlyDuclos
timide
timide

Messages : 19
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Transfert Nomenclature dans Excel

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum