Makro VBA do zapisania w programie Excel tabeli i nomenklatury pliku rysunku

tgohin · 28 Wrzesień 2021 14:49

Witam

Będąc początkującym i majsterkowiczem☺, szukam kodu lub makra do zapisania tabeli w formacie Excela na rysunku solidworks.

Oczywiście, na rysunku mam 2 tabele ''Tabela ERP'' i ''Nomenklatura ERP'' (patrz zrzut ekranu w załącznikach), które chcę zapisać w formacie excel (xls lub xlsx) w określonym katalogu.

Skleciłem kawałek kodu za pomocą jednego z moich istniejących makr, mogę utworzyć ścieżkę i nazwę pliku oraz wybrać tabele , ale nie wiem, jak zapisać .xls dla każdego wyboru.

To musi być bardzo proste, ale nie sądzę.

Z góry dziękuję za pomoc

Thierry

Wyciąg z obowiązującego Kodeksu:

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 Wrzesień 2021 05:41

Witam

Spójrz na te linki, gdzie temat został już wspomniany:

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 Wrzesień 2021 11:00

Witam

Jak wyjaśniono TUTAJ z przykładem TUTAJ.

Pozdrowienia

tgohin · 29 Wrzesień 2021 10:18

Dziękuję

Udało mi się awansować w moim makro, dla nomenklatury esportowej tabelowej to działa ☺

Z drugiej strony, dla tabeli ogólnej, znalazłem fragment kodu , który działa w celu utworzenia tabeli [ swtable = swDrawing.InsertTableAnnotation2(False, 0, 0, swBOMConfigurationAnchor_TopLeft, Templatetable, 4, 2)]

z drugiej strony w moim utworzonym pliku Excel pobiera formułę właściwości [$PRP:"Nazwa pliku SW"], ale nie wartość, podczas gdy w tabeli w oprogramowaniu jest poprawna (patrz zrzut ekranu) i nie mogę zmodyfikować kodu, aby usunąć utworzoną tabelę ogólną.

Złożyłem więc prośbę oprócz dyskusji na temat reza88

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

Dzięki sbadenis, robię postępy w moim makro

tgohin · 30 Wrzesień 2021 15:22

Witam

Dzięki @d.roger , ten kod działa bardzo dobrze dla nomenklatury (bom), ale nie znam modyfikacji, aby zrobić to samo z ''ogólną tabelą''.

Jeśli możesz mi pomóc, z góry dziękuję.

d_roger · 30 Wrzesień 2021 16:38

Witam

Spróbuj użyć następującego makra (nie zapomnij umieścić "Microsoft Excel xx.0 Object Library" w Narzędzia/Referencje):

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

Powinien działać na tabelach ogólnych, ale także na BOM-ach.

Pozdrowienia

tgohin · 4 Październik 2021 07:02

Witam

Jeszcze raz dziękuję @d.roger , mogę go zmusić do pracy na ogólnej tabeli, z drugiej strony w moim utworzonym pliku Excel pobiera formułę właściwości [$PRP:"Nazwa pliku SW"], ale nie wartość, podczas gdy w tabeli na SW pojawia się wartość (patrz zrzut ekranu).

Dziękuję

Pozdrowienia

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

d_roger · 4 Październik 2021 17:08

Witam

Nie widzę, skąd to może się wziąć i nie mogę odtworzyć problemu... Na wszelki wypadek opublikuj swój model stołu, aby sprawdzić, czy tak się z nim stanie.

Pozdrowienia

tgohin · 5 Październik 2021 06:11

Witaj @d.roger ,

Załączony plik, tabela i przykładowy kawałek i mep.

Moim zdaniem potrzebowałbym makra, które wykonuje polecenie "zapisz jako" tabeli ogólnej, ponieważ rozwiązanie polegające na kopiowaniu każdej komórki zwraca formułę, a nie wynik.

Pozdrowienia.

test.slddrw
test.sldprt
test_article.sldtbt

d_roger · 5 Październik 2021 07:52

Witam

Nie mogę użyć załączonych plików (przyszła wersja).

Aby zrobić "zapisz jako" tabelę, nie jest to zbyt skomplikowane, ale musisz przejść przez format pliku inny niż xls, czyli na przykład csv (zobacz TUTAJ):

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

Pozdrowienia

tgohin · 5 Październik 2021 15:20

Witaj @d.roger ,

W końcu znalazłem rozwiązanie, musisz użyć [ sht. Komórki(i + 1, j + 1). Wartość = swTable.DisplayedText(i, j)]

Zamiast [ sht. Komórki(I + 1, J + 1). Value = swTable.Text(I, J)] w celu uzyskania wyniku syntazy tabeli.

Z drugiej strony nadal nie znalazłem, jak usunąć utworzoną tabelę ogólną.

Dobranoc

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 Październik 2021 16:23

Witam

Ładne dla "DisplayedText". Aby usunąć tabelę, spróbuj wykonać coś takiego:

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

Pozdrowienia