Hallo
Ich möchte ein Makro erstellen, das eine vorhandene Excel-Datei einfügt, indem ich zunächst den Namen der Datei und ihren Speicherort für das Makro einfüge.
Ich habe die folgende Funktion ausprobiert, aber sie ist in der Solidworks-API nicht verwendbar.
Kennen Sie eine Möglichkeit, dieses Makro zu erstellen?
Vielen Dank
Hallo;
Um ein Excel-Dokument in meine Zeichnungen zu importieren, verwende ich dieses Makro (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
Mit diesem Makro können Sie die Excel-Zellen auswählen, die in die Solidworks-Zeichnung importiert werden sollen (in Form einer Stücklistentabelle).
Nach Ihren Wünschen zu ändern:
InitialFileName = der anfängliche Speicherort zum Öffnen eines Windows Explorers.
swTable.GetAnnotation.Layer = " Annotation " 'Wenn Sie einen bestimmten Layer für Ihre Tabellen verwenden.
ps: Seien Sie vorsichtig, das Meldungsfeld für die Validierung der Auswahl von Excel-Zellen kann davon verdeckt werden, wenn Excel auf demselben Bildschirm wie Solidworks geöffnet wird... keine Panik, es steckt direkt hinter Excel... 
(Wenn jemand einen Trick kennt, um sie, die msgbox, im Vordergrund anzuzeigen, nehme ich ihn gerne.)
Herzliche Grüße.
Anmerkung:
Denken Sie daran, die Solidworks-Version anzugeben, da die 3Dexperience-Version die Verwendung von Makros nicht immer akzeptiert (und möglicherweise auch die Excel-Version - aus den gleichen Gründen).
Bitte bevorzugen Sie Tags für die Codebearbeitung in diesem Forum.
Und um die gewünschte Programmiersprache anzugeben.
En complément, voici un petit tuto pour l'utilisation combinée d' Excel avec Solidworks: