VBA Macro to save in excel a table and nomenclature of a drawing file

tgohin · September 28, 2021, 2:49pm

Hello

Being a beginner and a tinkerer☺, I am looking for a code or macro to save a table in excel format on a solidworks drawing.

Clearly, in a drawing, I have 2 tables ''ERP Table'' & ''Nomenclature ERP'' (see screenshot in attachments) that I want to save in excel format (xls or xlsx) in a specific directory.

I cobbled together a piece of code using one of my existing macros, I can create my path and filename and select the tables but I don't know how to do the .xls saving for each selection.

It must be very simple but I don't think so.

Thank you in advance for your help

Thierry

Excerpt from the current Code:

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 · September 29, 2021, 5:41am

Hello

Look at these links where the subject has already been mentioned:

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 · September 29, 2021, 11:00am

Hello

As explained HERE with an example HERE.

Kind regards

tgohin · September 29, 2021, 10:18am

Thank you

I was able to advance in my macro, for table esport nomenclature it works ☺

On the other hand, for the general table, I did find a snippet of code that works to create the table [ swtable = swDrawing.InsertTableAnnotation2(False, 0, 0, swBOMConfigurationAnchor_TopLeft, Templatetable, 4, 2)]

on the other hand in my excel file created it retrieves the formula of the property [$PRP:"SW-File Name"] but not the value while on the table on SW is correct (see print screen) and I can't modify the code to delete the general table created.

So I made a request in addition to the discussion of reza88

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

Thanks sbadenis, I'm making progress on my macro

tgohin · September 30, 2021, 3:22pm

Hello

Thanks @d.roger , this code works very well for a nomenclature (bom) but I don't know the modification to do the same thing with a ''general table''.

If you can help me, thank you in advance.

d.roger · September 30, 2021, 4:38pm

Hello

Try with the following macro (don't forget to put "Microsoft Excel xx.0 Object Library" in Tools/References):

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

It should work on general tables but also on BOMs.

Kind regards

tgohin · October 4, 2021, 7:02am

Hello

Thanks again @d.roger , I can get it to work on the general table, on the other hand in my excel file created it retrieves the formula of the property [$PRP:"SW-File Name"] but not the value while on the table on SW the value appears (see screen print).

Thank you

Kind regards

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

d.roger · October 4, 2021, 5:08pm

Hello

I don't see where it can come from and I can't reproduce the problem... By any chance, post your table model to see if this happens with it.

Kind regards

tgohin · October 5, 2021, 6:11am

Hello @d.roger ,

Attached file table and example piece & mep.

In my opinion, I would need a macro that performs ''save as'' of the general table because the solution of copying each cell returns the formula and not the result.

Kind regards.

test.slddrw
test.sldprt
test_article.sldtbt

d.roger · October 5, 2021, 7:52am

Hello

I can't use your attached files (future version).

To make a "save as" of the table it's not too complicated but you have to go through a file format other than xls so csv for example (see HERE):

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

Kind regards

tgohin · October 5, 2021, 3:20pm

Hello @d.roger ,

I finally found the solution, you have to use [ sht. Cells(i + 1, j + 1). Value = swTable.DisplayedText(i, j)]

instead of [ sht. Cells(I + 1, J + 1). Value = swTable.Text(I, J)] in order to get the result of the table's synthase.

On the other hand, I still haven't found how to delete the created general table.

Good night

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 · October 5, 2021, 4:23pm

Hello

Nice for the "DisplayedText". For table deletion, try something like:

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

Kind regards