VBA-Makro zum Speichern einer Tabelle und Nomenklatur einer Zeichnungsdatei in Excel

tgohin · 28. September 2021 um 14:49

Hallo

Als Anfänger und Tüftler☺ bin ich auf der Suche nach einem Code oder Makro, um eine Tabelle im Excel-Format in einer SOLIDWORKS-Zeichnung zu speichern.

Offensichtlich habe ich in einer Zeichnung 2 Tabellen ''ERP-Tabelle'' & ''Nomenklatur ERP'' (siehe Screenshot in den Anhängen), die ich im Excel-Format (xls oder xlsx) in einem bestimmten Verzeichnis speichern möchte.

Ich habe ein Stück Code mit einem meiner vorhandenen Makros zusammengeschustert, ich kann meinen Pfad und Dateinamen erstellen und die Tabellen auswählen, aber ich weiß nicht, wie ich die .xls Speichern für jede Auswahl durchführen soll.

Es muss sehr einfach sein, aber ich glaube nicht.

Vielen Dank im Voraus für Ihre Hilfe

Thierry

Auszug aus dem aktuellen Kodex:

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 · 29. September 2021 um 05:41

Hallo

Schauen Sie sich diese Links an, wo das Thema bereits erwähnt wurde:

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 · 29. September 2021 um 11:00

Hallo

Wie HIER mit einem Beispiel HIER erklärt.

Herzliche Grüße

tgohin · 29. September 2021 um 10:18

Vielen Dank

Ich konnte in meinem Makro vorankommen, für die Nomenklatur der Tabelle esport funktioniert ☺ es

Auf der anderen Seite habe ich für die allgemeine Tabelle einen Codeausschnitt gefunden , der funktioniert, um die Tabelle zu erstellen [ swtable = swDrawing.InsertTableAnnotation2(False, 0, 0, swBOMConfigurationAnchor_TopLeft, Templatetable, 4, 2)]

Auf der anderen Seite ruft es in meiner erstellten Excel-Datei die Formel der Eigenschaft [$PRP:"SW-Dateiname"] ab, aber nicht den Wert, während die Tabelle auf SW korrekt ist (siehe Druckbildschirm) und ich kann den Code nicht ändern, um die erstellte allgemeine Tabelle zu löschen.

Also habe ich zusätzlich zur Diskussion über reza88 eine Anfrage gestellt

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

Danke sbadenis, ich mache Fortschritte bei meinem Makro

tgohin · 30. September 2021 um 15:22

Hallo

Danke @d.roger , dieser Code funktioniert sehr gut für eine Nomenklatur (bom), aber ich kenne die Änderung nicht, um dasselbe mit einer ''allgemeinen Tabelle'' zu tun.

Wenn Sie mir helfen können, danke ich Ihnen im Voraus.

d.roger · 30. September 2021 um 16:38

Hallo

Versuchen Sie es mit dem folgenden Makro (vergessen Sie nicht, "Microsoft Excel xx.0 Object Library" in Tools/References einzufügen):

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

Es sollte auf allgemeinen Tabellen, aber auch auf Stücklisten funktionieren.

Herzliche Grüße

tgohin · 4. Oktober 2021 um 07:02

Hallo

Nochmals vielen Dank @d.roger , ich kann es auf die allgemeine Tabelle zum Laufen bringen, andererseits ruft es in meiner erstellten Excel-Datei die Formel der Eigenschaft [$PRP:"SW-Dateiname"] ab, aber nicht den Wert, während auf der Tabelle auf SW der Wert erscheint (siehe Siebdruck).

Vielen Dank

Herzliche Grüße

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

d.roger · 4. Oktober 2021 um 17:08

Hallo

Ich sehe nicht, woher es kommen kann, und ich kann das Problem nicht reproduzieren... Veröffentlichen Sie auf jeden Fall Ihr Tabellenmodell, um zu sehen, ob dies damit passiert.

Herzliche Grüße

tgohin · 5. Oktober 2021 um 06:11

Hallo @d.roger ,

Beigefügte Aktentabelle und Beispielstück & mep.

Meiner Meinung nach bräuchte ich ein Makro, das ''Speichern unter'' der allgemeinen Tabelle ausführt, da die Lösung, jede Zelle zu kopieren, die Formel und nicht das Ergebnis zurückgibt.

Herzliche Grüße.

test.slddrw
test.sldprt
test_article.sldtbt

d.roger · 5. Oktober 2021 um 07:52

Hallo

Ich kann Ihre angehängten Dateien (zukünftige Version) nicht verwenden.

Um ein "Speichern unter" der Tabelle zu machen, ist es nicht allzu kompliziert, aber Sie müssen ein anderes Dateiformat als xls verwenden, also csv zum Beispiel (siehe 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

Herzliche Grüße

tgohin · 5. Oktober 2021 um 15:20

Hallo @d.roger ,

Ich habe endlich die Lösung gefunden, man muss [ sht verwenden . Zellen(i + 1, j + 1). Wert = swTable.DisplayedText(i, j)]

Anstelle von [ sht. Zellen (I + 1, J + 1). Value = swTable.Text(I, J)], um das Ergebnis der Synthase der Tabelle zu erhalten.

Auf der anderen Seite habe ich immer noch nicht gefunden, wie ich die erstellte allgemeine Tabelle löschen kann.

Gute Nacht

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 · 5. Oktober 2021 um 16:23

Hallo

Schön für den "DisplayedText". Versuchen Sie zum Löschen von Tabellen Folgendes:

swTable.GetAnnotation() verwenden. Auswählen3 Falsch, Nichts
swModel.EditDelete

Herzliche Grüße