VBA Macro om in Excel een tabel en nomenclatuur van een tekeningbestand op te slaan

Out of category
1

Hallo

Als beginner en knutselaar☺ ben ik op zoek naar een code of macro om een tabel in Excel-formaat op een solidworks-tekening op te slaan.

Het is duidelijk dat ik in een tekening 2 tabellen heb ''ERP Table'' & ''Nomenclature ERP'' (zie screenshot in bijlagen) die ik  in Excel-formaat  (xls of xlsx) in een specifieke directory wil opslaan.

Ik heb een stuk code in elkaar geflanst met behulp van een van mijn bestaande macro's, ik kan mijn pad en bestandsnaam maken en de tabellen selecteren, maar ik weet niet hoe ik de .xls opslaan voor elke selectie.

Het moet heel simpel zijn, maar ik denk het niet.

Bij voorbaat dank voor uw hulp

Thierry

 

Uittreksel uit de huidige 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
2

Hallo

Kijk naar deze links waar het onderwerp al genoemd is:

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

3

Hallo

Zoals HIER uitgelegd met een voorbeeld HIER.

Vriendelijke groeten

2 likes
4

Bedankt

Ik was in staat om vooruitgang te boeken in mijn macro, voor tafel esport nomenclatuur werkt ☺ het

Aan de andere kant heb ik voor de algemene tabel wel een stukje code  gevonden  dat werkt om de tabel te maken [ swtable = swDrawing.InsertTableAnnotation2(False, 0, 0, swBOMConfigurationAnchor_TopLeft, Templatetable, 4, 2)]   

aan de andere kant haalt het in mijn gemaakte Excel-bestand de formule van de eigenschap [$PRP:"SW-File Name"] op, maar niet de waarde terwijl de tabel op SW staat is correct (zie print screen)  en ik kan de code niet wijzigen om de gemaakte algemene tabel te verwijderen.

Dus heb ik een verzoek gedaan naast de bespreking van reza88

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

Bedankt Sbadenis,  ik ben het vorderen van mijn macro

5

Hallo

 

Bedankt @d.roger , deze code werkt heel goed voor een nomenclatuur (bom),  maar ik weet niet de wijziging om hetzelfde te doen met een ''algemene tabel''.

Als je me kunt helpen, dank je bij voorbaat.

 

6

Hallo

Probeer het met de volgende macro (vergeet niet om "Microsoft Excel xx.0 Object Library" in Tools/References te zetten):

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

Het zou moeten werken op algemene tabellen, maar ook op stuklijsten.

Vriendelijke groeten

1 like
7

Hallo

Nogmaals bedankt @d.roger , ik kan het aan het werk krijgen op de algemene tabel, aan de andere kant in mijn Excel-bestand gemaakt haalt het de formule van de eigenschap [$PRP:"SW-File Name"] op, maar niet de waarde,       terwijl op de tabel op SW de waarde verschijnt  (zie schermafdruk).

 

Bedankt

Vriendelijke groeten

 


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

Hallo

Ik zie niet waar het vandaan kan komen en ik kan het probleem niet reproduceren... Plaats toevallig uw tafelmodel om te zien of dit ermee gebeurt.

Vriendelijke groeten

9

Hallo @d.roger ,

Bijgevoegde dossiertabel en voorbeeldstuk & MEP.

Naar mijn mening zou ik een macro nodig hebben die ''opslaan als'' van de algemene tabel uitvoert, omdat de oplossing van het kopiëren van elke cel de formule retourneert en niet het resultaat.

Vriendelijke groeten.

 

 

 


test.slddrw
test.sldprt
test_article.sldtbt
10

Hallo

Ik kan uw bijgevoegde bestanden (toekomstige versie) niet gebruiken.

Om een "save as" van de tabel te maken is het niet al te ingewikkeld, maar je moet een ander bestandsformaat dan xls dus csv doorlopen (zie HIER):

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

Vriendelijke groeten

11

Hallo @d.roger ,

Ik heb eindelijk de oplossing gevonden, je moet  [ sht. Cellen (i + 1, j + 1). Waarde = swTable.DisplayText(i, j)]

   In plaats van  [ sht. Cellen (I + 1, J + 1). Waarde = swTable.Text(I, J)]  om het resultaat van de synthase van de tabel te krijgen.

Aan de andere kant heb ik nog steeds niet gevonden hoe ik de gemaakte algemene tabel kan verwijderen.

 

Goedenacht

 

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

 

1 like
12

Hallo

Leuk voor de "DisplayText". Probeer iets als: Voor het verwijderen van tabellen kunt u iets als:

swTable.GetAnnotation(). Select3 Onwaar, niets
swModel.EditDelete

Vriendelijke groeten