Hallo
Ik wil een macro maken die een bestaand Excel-bestand invoegt, eerst door de naam van het bestand en de locatie van de macro op te geven.
Ik heb de onderstaande functie geprobeerd, maar deze is niet bruikbaar in de solidworks API.
Weet u een manier om deze macro te bouwen?
Bedankt
Hallo;
Om een Excel-document in mijn tekeningen te importeren, gebruik ik deze macro (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
Met deze macro kunt u de Excel-cellen selecteren die u wilt importeren in de Solidworks-tekening (in de vorm van een stuklijsttabel).
Aan te passen aan uw voorkeuren:
InitialFileName = de initiële locatie voor het openen van een Windows Verkenner.
swTable.GetAnnotation.Layer = " Annotatie " 'Als u een bepaalde laag gebruikt voor uw tabellen.
ps: Wees voorzichtig, het berichtvenster voor de validatie van de selectie van Excel-cellen kan erdoor worden verborgen als Excel op hetzelfde scherm wordt geopend als Solidworks... geen paniek, het is net achter Excel... 
(Als iemand een truc weet om het weer te geven, de msgbox, op de voorgrond, neem ik het graag aan.)
Vriendelijke groeten.
Notitie:
Vergeet niet om de Solidworks-versie te specificeren, de 3Dexperience-versie accepteert niet altijd het gebruik van macro's (en mogelijk ook de Excel-versie - om dezelfde redenen).
Geef de voorkeur aan tags voor het bewerken van codes in dit forum.
En om de gewenste programmeertaal op te geven.
En complément, voici un petit tuto pour l'utilisation combinée d' Excel avec Solidworks: