Hallo zusammen
Ich bin neu hier im Forum und auch noch ein ziemlicher Anfänger was Makros anbelangt.
Auf der Suche nach einer Lösung um die SolidWorks Stüli in eine formatierte Excel Tabelle einzulesen bin ich auf auf den Code von "riesi" gestossen.
Ich konnte Ihn soweit anpassen dass ich die komplette Stüli in Excel einlesen kann.
Das einzige Problem dass ich jetzt noch habe ist, dass die Stüli direkt in der ersten Zeile eingefügt wird.
Da ich einen definierten Blattkopf habe möchte ich dass die Stüli erst ab der dritten oder vierten Zeile eingefügt wird. Evtl. kann mir jemand bei diesem Befehl weiterhelfen. 
Sub main()
Dim swApp As Object
Dim swModel As Object
Dim swDraw As Object
Dim swView As Object
Dim swTable As Object
Dim swFeat As Object
Dim swBomFeat As Object
Dim bRet As Boolean
Dim swAnn As Object
Dim nNumCol As Long
Dim nNumRow As Long
Dim sRowStr As String
Dim sTitStr As String
Dim a As Long
Dim j As Long
Dim b As Long
Dim intOutHandle As Integer
Dim strOneLine As String
Dim SWXBom() As String
Dim sZelle As String
Dim Benennung As Integer
Dim Mass1Spalte As Integer
Dim PosSpalte As Integer
Dim MengenSpalte As Integer
Dim Zeichnungsnummer As Integer
Dim Hersteller As Integer
Dim HerstellerSachnummer As Integer
Dim ErsatzVerschleiss As Integer
Dim NormTyp As Integer
Dim Material As Integer
Dim Lieferant As Integer
Dim Kosten As Integer
Dim xlApp As Object
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Keine Dokumentnte geöffnet."
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "Das Dokument ist keine Zeichnung."
End
End If
Set swDraw = swModel
Set swView = swDraw.GetFirstView
Set swTable = swView.GetFirstTableAnnotation
If swTable Is Nothing Then
MsgBox "Die Zeichnung enthält keine Stückliste"
End
End If
Do While swTable.Type <> 2
Set swTable = swTable.GetNext
If swTable Is Nothing Then
MsgBox "Die Zeichnung enthält keine Stückliste"
End
End If
Loop
' Debug.Print swTable.Type
nNumCol = swTable.ColumnCount
nNumRow = swTable.RowCount
' Stüli auslesen
For j = 0 To nNumCol - 1
sTitStr = Trim(swTable.GetColumnCustomProperty(j))
If sTitStr = "Benennung" Then
Benennung = j
'Debug.Print sTitStr
ElseIf sTitStr = "Zeichnungsnummer" Then
Zeichnungsnummer = j
'Debug.Print sTitStr
ElseIf sTitStr = "Lieferant" Then
Lieferant = j
'Debug.Print sTitStr
ElseIf sTitStr = "Norm-Typ" Then
NormTyp = j
'Debug.Print sTitStr
ElseIf sTitStr = "Material" Then
Material = j
'Debug.Print sTitStr
ElseIf sTitStr = "Hersteller" Then
Hersteller = j
'Debug.Print sTitStr
ElseIf sTitStr = "Hersteller Sachnummer" Then
HerstellerSachnummer = j
'Debug.Print sTitStr
ElseIf sTitStr = "E/V" Then
ErsatzVerschleiss = j
'Debug.Print sTitStr
ElseIf sTitStr = "Kosten" Then
Kosten = j
'Debug.Print sTitStr
End If
'Debug.Print sTitStr
sTitStr = Trim(swTable.Text(0, j))
If sTitStr = "Pos." Then
PosSpalte = j
'Debug.Print sTitStr
ElseIf sTitStr = "Menge" Then
MengenSpalte = j
'Debug.Print sTitStr
End If
'Debug.Print sTitStr
Next j
ReDim SWXBom(nNumRow, 11)
For a = 0 To nNumRow - 0
SWXBom(a, 1) = swTable.Text(a, PosSpalte)
'Debug.Print SWXBom(i, 1)
SWXBom(a, 2) = swTable.Text(a, MengenSpalte)
'Debug.Print SWXBom(i, 2)
SWXBom(a, 3) = swTable.Text(a, Benennung)
'Debug.Print SWXBom(i, 3)
SWXBom(a, 4) = swTable.Text(a, Zeichnungsnummer)
'Debug.Print SWXBom(i, 4)
SWXBom(a, 5) = swTable.Text(a, HerstellerSachnummer)
'Debug.Print SWXBom(i, 5)
SWXBom(a, 6) = swTable.Text(a, ErsatzVerschleiss)
'Debug.Print SWXBom(i, 6)
SWXBom(a, 7) = swTable.Text(a, NormTyp)
'Debug.Print SWXBom(i, 7)
SWXBom(a, 8) = swTable.Text(a, Material)
'Debug.Print SWXBom(i, 8)
SWXBom(a, 9) = swTable.Text(a, Hersteller)
'Debug.Print SWXBom(i, 9)
SWXBom(a, 10) = swTable.Text(a, Lieferant)
'Debug.Print SWXBom(i, 10)
If swTable.Text(a, Kosten) <> "" Then
SWXBom(a, 11) = swTable.Text(a, Kosten)
If Right(SWXBom(a, 11), 2) = "Kosten" Then SWXBom(a, 2) = Left(SWXBom(a, 11), Len(SWXBom(a, 11)) - 2)
'Debug.Print SWXBom(i, 4)
End If
Next a
Set swApp = Nothing
Set swModel = Nothing
Set swDraw = Nothing
Set swView = Nothing
Set swTable = Nothing
Set xlApp = CreateObject("Excel.Application")
For a = 1 To nNumRow - 2
For j = 1 To 11
Debug.Print SWXBom(a, j)
Cells(a, j).Value = SWXBom(a, j)
Next j
Next a
Set xlApp = Nothing
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
-Stüli aus ?
