Wstawianie pliku Excela do rysunku solidworks za pomocą makra

Macro
1

Witam

Chcę utworzyć makro, które wstawia istniejący plik programu Excel, najpierw podając nazwę pliku i jego lokalizację makra.

Wypróbowałem poniższą funkcję, ale nie można jej używać w API solidworks.

image

Czy znasz sposób na zbudowanie tego makra?

Dziękuję

2

Witam;
Aby zaimportować dokument Excel do moich rysunków, używam tego makra (VBA):


' Prérequis: Une Mise en plan Solidworks est ouverte.

Option Explicit

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swDraw                  As SldWorks.DrawingDoc

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    
    ImportTable swDraw
    
End Sub

Sub ImportTable(drawingSheet As SldWorks.DrawingDoc)

    Dim swTable                 As SldWorks.TableAnnotation
    Dim swAnn                   As SldWorks.Annotation
    Dim nNumCol                 As Long
    Dim nNumRow                 As Long
    Dim sRowStr                 As String
    Dim i                       As Long
    Dim j                       As Long
    
    Dim objExcelObject          As Excel.Application
    Dim objBook1                As Excel.Workbook
    Dim objSheet1               As Excel.Worksheet
    
    Dim iRows                   As Integer
    Dim iCols                   As Integer
    Dim sBase                   As String

Set objExcelObject = Excel.Application
'----------------------------------------------------------------------------------------------------------------------------
Dim MonChemin As String
Dim MonClasseur As Excel.Workbook

    If MsgBox("Choisissez un fichier à ouvrir", vbOKCancel, "Nouveau Fichier") = vbOK Then
        With objExcelObject.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "W:\Affaires\" 'Emplacement à modifier selon emplacement initial de la recherche des documents Excel
            .AllowMultiSelect = False ' on choisit un seul fichier
            If .Show Then             ' on vérifie que l'utilisateur a bien choisi un fichier et n'a pas appuyé sur "annuler"
                MonChemin = .SelectedItems(1)
            Else
                MsgBox "Aucune fichier sélectionné"
                'exit sub ?
            End If
        End With
    End If
 
 Dim xlApp As Excel.Application
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set MonClasseur = xlApp.Workbooks.Open(MonChemin)
'----------------------------------------------------------------------------------------------------------------------------
    
    MsgBox ("Ouvrez le fichier Excel,et sélectionnez les cellules à importer." & Chr(10) & "...." & Chr(10) & "Cliquez sur 'OK' pour débuter l'importation.")

    If objExcelObject Is Nothing Then
       MsgBox "Un fichier Excel doit être ouvert." & Chr(10) & "Fin de la macro."
    Else
With MonClasseur.Worksheets(1)

    iRows = xlApp.Selection.Rows.Count
    iCols = xlApp.Selection.Columns.Count
    sBase = xlApp.Selection.Cells(1, 1).Address
End With

    Dim sWidth As Double
    Dim sHeight As Double
    
    drawingSheet.GetCurrentSheet().GetSize sWidth, sHeight

    Set swTable = drawingSheet.InsertTableAnnotation2(False, 0, sHeight, swBOMConfigurationAnchor_TopLeft, "", iRows, iCols)
    
    For i = 0 To iRows - 1
        Dim cell As Range
        
        For j = 0 To iCols - 1
            'Set cell = objExcelObject.Selection.Range("A1").Offset(i, j)
            Set cell = xlApp.Selection.Range("A1").Offset(i, j)
            
            If i = 0 Then
                ' Definition des largeurs de colonnes
                swTable.SetColumnWidth j, cell.ColumnWidth * 7.5 / 4000, swTableRowColChange_TableSizeCanChange
            End If
            
            ' Definition du format des cellules
            Dim tf As TextFormat
            Set tf = swTable.GetTextFormat
            
            tf.Bold = cell.Font.Bold
            tf.Strikeout = cell.Font.Strikethrough
            tf.Italic = cell.Font.Italic
            If cell.Font.Underline > 0 Then tf.Underline = True
            tf.CharHeightInPts = cell.Font.Size
            
            
            ' Definition du format du texte
            swTable.SetCellTextFormat i, j, False, tf
            
            
            ' Alignement des cellules
            swTable.CellTextHorizontalJustification(i, j) = Switch(cell.HorizontalAlignment = XlHAlign.xlHAlignRight, swTextJustificationRight, cell.HorizontalAlignment = XlHAlign.xlHAlignCenter, swTextJustificationCenter, True, swTextJustificationLeft)
            swTable.CellTextVerticalJustification(i, j) = Switch(cell.VerticalAlignment = XlVAlign.xlVAlignBottom, swTextAlignmentBottom, cell.VerticalAlignment = XlVAlign.xlVAlignCenter, swTextAlignmentMiddle, True, swTextAlignmentTop)
            
            swTable.Text(i, j) = cell
        
        Next j
        ' Definition des Hauteur de colonnes
        swTable.SetRowHeight i, cell.RowHeight / 0.75 / 4000, swTableRowColChange_TableSizeCanChange
        
        swTable.GetAnnotation.Layer = "Annotation"
        
    Next i
        
    End If
 
    Set objSheet1 = Nothing
    Set objBook1 = Nothing
    Set objExcelObject = Nothing
        
End Sub

To makro umożliwia wybranie komórek programu Excel do zaimportowania do rysunku Solidworks (w postaci tabeli zestawienia komponentów).
Do modyfikacji zgodnie z własnymi preferencjami:
InitialFileName = początkowa lokalizacja do otwarcia Eksploratora Windows.
swTable.GetAnnotation.Layer = " Adnotacja  " 'Jeśli używasz określonej warstwy dla swoich tabel.

ps: Bądź ostrożny, okno komunikatu do walidacji wyboru komórek Excela może być przez nie ukryte, jeśli Excel jest otwarty na tym samym ekranie co Solidworks... nie panikuj, jest tuż za Excelem... :sweat_smile:
(Jeśli ktoś zna sztuczkę, aby wyświetlić to, msgbox, na pierwszym planie, chętnie się z niego skorzystam.)

Pozdrowienia.

Nuta:
Pamiętaj, aby określić wersję Solidworks, wersja 3Dexperience nie zawsze akceptuje użycie makra (i być może również wersji Excel - z tych samych powodów).
Prosimy o preferowanie tagów do edycji kodu na tym forum.
image
I określić żądany język programowania.

3 polubienia
3

En complément, voici un petit tuto pour l'utilisation combinée d' Excel avec Solidworks: