VBA Macro pour enregistrer en excel une table et nomenclature d'un fichier mise en plan

tgohin · Septembre 28, 2021, 2:49

Bonjour,

Etant débutant et bidouilleur☺, je cherche un code ou macro pour faire l'enregistrement au format excel d'une table sur une mise en plan solidworks.

Clairement, dans une mise plan, j'ai 2 tables ''Table ERP'' & ''Nomenclature ERP'' (voir imprimécran en pièces jointe) que je souhaite enregistrer au format excel (xls ou xlsx) dans un répertoire précis.

J'ai bricolé un bout de code à l'aide d'une de mes macro existantes, j'arrive bien a créer mon chemin et nom de fichier et a sélectionner les tables mais je ne sais pas comment faire pour faire l'enregistrement en .xls pour chaque sélection.

Ca doit être tout simple mais je ne trouve pas.

Merci d'avance pour vos aides

Thierry

Extrait du Code en cours:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Dim myVar As Variant, RetVal As Integer, Reponse2 As String


boolstatus = Part.ActivateSheet("Feuille2")

myRev = Part.GetCustomInfoValue("", "Révision")

 Const swCommands_Save As Long = 2


'DOSSIER ATTENTE & NOM de FICHIER EXCEL
 myVar = Split(Part.GetPathName, "\", -1)

'Chemin et nom de fichier XLS pour table ERP
myNew_table_ERP = "C:\0-Plan en Attente" & "\" & Mid(myVar(UBound(myVar)), 1, Len(myVar(UBound(myVar))) - 7) & "-" & myRev & ".xlsx"
         
'Sélection ''table ERP''
boolstatus = Part.Extension.SelectByID2("Table ERP", "GENERALTABLEFEAT", 0, 0, 0, False, 0, Nothing, 0)
    
'enregistrer en xls ''table ERP''
  
?????????????????   

 
'Chemin et nom de fichier XLS pour Nomenclature ERP
myNew_Nomenclature ERP = "C:\0-Plan en Attente" & "\" & Mid(myVar(UBound(myVar)), 1, Len(myVar(UBound(myVar))) - 7) & "-" & Nomen & ".xlsx        
       
 'Sélection ''Nomenclature ERP''
boolstatus = Part.Extension.SelectByID2("Nomenclature ERP", "BOMFEATURE", 0, 0, 0, False, 0, Nothing, 0)
    

'enregistrer en xls ''Nomenclature ERP''


?????????????????   




End Sub

feature.jpg

sbadenis · Septembre 29, 2021, 5:41

Bonjour,

Regarde ces quelques lien ou le sujet à déjà été évoqué:

https://www.lynkoa.com/forum/import-de-donn%C3%A9es-num%C3%A9ris%C3%A9es/export-nomenclature-vers-excel

https://www.lynkoa.com/forum/solidworks/exportation-vba-nomenclature-solidworks-vers-excel

https://www.lynkoa.com/forum/solidworks/nomenclature-excel

d.roger · Septembre 29, 2021, 11:00

Bonjour,

Comme expliqué ICI avec un exemple ICI.

Cordialement,

tgohin · Septembre 29, 2021, 10:18

Merci,

J'ai pu avancé dans ma macro, pour l'esport de table nomenclature ça marche ☺

Par contre pour la table générale, j'ai bien trouvé un bout de code qui fonctionne pour créer la table [ swtable = swDrawing.InsertTableAnnotation2(False, 0, 0, swBOMConfigurationAnchor_TopLeft, Templatetable, 4, 2)]

par contre dans mon fichier excel créé cela récupère la formule de la propriété [$PRP:"SW-Nom de fichier(File Name)"] mais pas la valeur alors que sur la table sur SW est correct (voir imprim ecran) et je n'arrive pas a modifier le code pour supprimer la table général créé.

J'ai donc fait une demande sup à la discussion de reza88

https://www.lynkoa.com/forum/solidworks/exportation-vba-nomenclature-solidworks-vers-excel?page=0

Merci sbadenis, je progresse sur ma macro

tgohin · Septembre 30, 2021, 3:22

Bonjour,

Merci @d.roger , ce code fonctionne trés bien pour une nomenclature (bom) mais je ne connais pas la modification pour faire la même chose avec une ''table générale''.

Si tu peux m'aider, d'avance merci.

d.roger · Septembre 30, 2021, 4:38

Bonjour,

Essaye avec la macro suivante (sans oublier de mettre "Microsoft Excel xx.0 Object Library" dans Outils/Références) :

Option Explicit

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swSM                    As ISelectionMgr
Dim xlApp                   As Excel.Application
Dim wbk                     As Excel.Workbook
Dim sht                     As Excel.Worksheet
Dim swTable                 As SldWorks.ITableAnnotation
Dim NumCol                  As Long
Dim NumRow                  As Long
Dim I                       As Long
Dim J                       As Long
Dim chemin                  As String

Sub xls()
    Set xlApp = New Excel.Application
    
    With xlApp
        .Visible = True
        Set wbk = .Workbooks.Add
        Set sht = wbk.ActiveSheet
   End With
    
    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc
    
    Set swSM = swModel.SelectionManager
    Set swTable = swSM.GetSelectedObject6(1, -1)
    swModel.ClearSelection2 (True)

    NumCol = swTable.ColumnCount
    NumRow = swTable.RowCount
    For I = 0 To NumRow
        For J = 0 To NumCol
            sht.Cells(I + 1, J + 1).Value = swTable.Text(I, J)
        Next J
    Next I
    
    Dim ExcelName As String
    ExcelName = swModel.GetPathName()
    ExcelName = Left(ExcelName, InStrRev(ExcelName, "\"))
    chemin = ExcelName & "_export" & ".xls"
    
    With xlApp
        wbk.SaveAs chemin
        wbk.Close
        .Quit
    End With
 
End Sub

Ca devrait fonctionner sur les tables générales mais aussi sur les BOM.

Cordialement,

tgohin · Octobre 4, 2021, 7:02

Bonjour,

Encore merci @d.roger , j'arrive bien à faire fonctionner sur table générale, par contre dans mon fichier excel créé cela récupère la formule de la propriété [$PRP:"SW-Nom de fichier(File Name)"] mais pas la valeur alors que sur la table sur SW la valeur apparait (voir imprim ecran).

Merci

Cordialement

2021-10-04_09_00_38-solidworks_2021_sp3.0.png

d.roger · Octobre 4, 2021, 5:08

Bonjour,

Je ne vois pas d'où cela peut venir et je n'arrive pas à reproduire le souci ... à tout hasard poste ton modèle de table pour voir si cela se produit avec celui-ci.

Cordialement,

tgohin · Octobre 5, 2021, 6:11

Bonjour @d.roger ,

Ci-joint fichier table et exemple piéce & mep.

Selon moi il me faudrait une macro qui réalise '' enregistrer sous'' de la table générale car la solution acteul de copie de chaque cellule me renvoi la formule et non le résultat.

Cordialement.

test.slddrw
test.sldprt
test_article.sldtbt

d.roger · Octobre 5, 2021, 7:52

Bonjour,

Je n'arrive pas à utiliser tes fichiers joints (version future).

Pour réaliser un "enregistrer sous" de la table c'est pas trop compliqué mais il faut passer par un format de fichier autre que xls donc du csv par exemple (voir ICI) :

Dim swApp As SldWorks.SldWorks
Dim swModDoc As SldWorks.IModelDoc2
Dim swTable As SldWorks.TableAnnotation

Public Sub Main()
    Set swApp = Application.SldWorks

    Set swModDoc = swApp.ActiveDoc
    Dim swSM As ISelectionMgr
    Set swSM = swModDoc.SelectionManager
    Set swTable = swSM.GetSelectedObject6(1, -1)
    swModDoc.ClearSelection2 (True)
    
    Status = swTable.SaveAsText2("C:\temp\MaTable.csv", ";", True)
End Sub

Cordialement,

tgohin · Octobre 5, 2021, 3:20

Bonjour @d.roger ,

J'ai enfin trouvé la solution, il faut utiliser [ sht.Cells(i + 1, j + 1).Value = swTable.DisplayedText(i, j)]

au lieu de [ sht.Cells(I + 1, J + 1).Value = swTable.Text(I, J)] afin d'avoir le résultat de la synthase de la table.

Par contre, je n'ai toujours pas trouvé comment supprimer la table général créé.

Bonne soirée

Dim swModel                 As SldWorks.ModelDoc2
Dim swSM                    As ISelectionMgr
Dim xlApp                   As Excel.Application
Dim wbk                     As Excel.Workbook
Dim sht                     As Excel.Worksheet
Dim swTable                 As SldWorks.ITableAnnotation
Dim NumCol                  As Long
Dim NumRow                  As Long
Dim i                       As Long
Dim j                       As Long
Dim chemin                  As String


Sub Créat_Table()
    Dim swapp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swActiveView As SldWorks.View
    Dim swBOMTable As SldWorks.BomTableAnnotation
    Dim Config As String
    Dim TemplateName As String
    Dim swTable As SldWorks.TableAnnotation
    Dim myModelView As Object

    Set swapp = Application.SldWorks
    Set swModel = swapp.ActiveDoc
    Set swDraw = swModel
    Set swActiveView = swDraw.GetFirstView
    Set swActiveView = swActiveView.GetNextView
    Config = swActiveView.ReferencedConfiguration
    
           
Set Part = swapp.ActiveDoc
    

Set myModelView = Part.ActiveView

myModelView.FrameState = swWindowState_e.swWindowMaximized

    Dim myVar As Variant, RetVal As Integer, Reponse2 As String
        

myRev = Part.GetCustomInfoValue("", "Révision")

'CHEMIN MODELE TABLES
    Templatetable = "C:\test article.sldtbt"
    

'NOM de FICHIER EXCEL

 myVar = Split(Part.GetPathName, "\", -1)


'CHEMIN REPERTOIRE FICHIER ATTENTE

    chemin = "C:\0-Plan en Attente"
    
           
'CREATION TABLE

Set swDrawing = swModel
Set xlApp = New Excel.Application
    
    With xlApp
        .Visible = True
        Set wbk = .Workbooks.Add
        Set sht = wbk.ActiveSheet
   End With
    
Set swapp = Application.SldWorks
Set swModel = swapp.ActiveDoc
Set swSM = swModel.SelectionManager
Set swTable = swDrawing.InsertTableAnnotation2(False, 0, 0.3, swBOMConfigurationAnchor_TopLeft, Templatetable, 2, 2)





    NumCol = swTable.ColumnCount
    NumRow = swTable.RowCount
    For i = 0 To NumRow
        For j = 0 To NumCol
        
            sht.Cells(i + 1, j + 1).Value = swTable.DisplayedText(i, j)
        Next j
    Next i
    

With xlApp
   wbk.SaveAs chemin & "\" & Mid(myVar(UBound(myVar)), 1, Len(myVar(UBound(myVar))) - 7) & "-" & myRev & ".xls"
     wbk.Close
      .Quit
    End With
    
           

  'delete table
  

    'Dim swtable As SldWorks.tableFeature
   ' Set swtable = swtable.BomFeature
    'Dim swtable As SldWorks.Feature
    'Set swtable = swtable.GetFeature
    'swFeat.Select2 False, -1
    'swModel.EditDelete



    
End Sub

d.roger · Octobre 5, 2021, 4:23

Bonjour,

Bien vu pour le "DisplayedText". Pour la suppression de la table, essaye quelque chose comme :

swTable.GetAnnotation().Select3 False, Nothing
swModel.EditDelete

Cordialement,