Hello.
I want to sort the created BOM in ascending order in columns B and C as in the image settings, but it does not work properly.
Please help me.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawing As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swBOMTableAnnotation As SldWorks.BomTableAnnotation
Dim swTableAnnotation As SldWorks.TableAnnotation
Dim nNumRow As Long
Dim sRowStr As String
Dim i As Long
Dim j As Long
Dim tableTemplate As String
Dim config As String
Dim boolstatus As Boolean
Public template As String
Public anchorType As String
Public bomType As Long
Public flag As Integer
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "ファイルが開かれてません" & vbCrLf & "ファイルを開きマクロ実行して下さい", vbCritical
GoTo Err1
End If
Dim Doctype As Long
Doctype = swModel.GetType
If Doctype <> 3 Then
MsgBox "図面が選択されてません" & vbCrLf & "図面を選択しマクロ実行して下さい", vbCritical
GoTo Err1
End If
Set swDrawing = swModel
Set swView = swDrawing.GetCurrentSheet.GetViews()(0)
UserForm1.Show
If flag = 1 Then
MsgBox "キャンセルしました", vbInformation
flag = 0
GoTo Err1
End If
tableTemplate = template
config = ""
On Error Resume Next
Set swBOMTableAnnotation = swView.InsertBomTable4(True, 0, 0, anchorType, bomType, config, tableTemplate, False, swNumberingType_Detailed, False)
Set swTableAnnotation = swBOMTableAnnotation
If Err.Number > 0 Then
MsgBox "部品表を作成出来ませんでした" & vbCrLf & "最初からやり直して下さい", vbInformation
On Error GoTo 0
GoTo Err1
End If
On Error GoTo 0
swTableAnnotation.BorderLineWeight = 0.18
swTableAnnotation.GridLineWeight = 0.18
------------------------------------------------------------------------------------------------
'BOM SORTBOM sorting
Dim swSortData As BomTableSortData
Dim sortSaved As Boolean
Set swSortData = swTableAnnotation.GetBomTableSortData
swSortData.ColumnIndex(0) = 3
swSortData.Ascending(0) = True
swSortData.ColumnIndex(1) = 4
swSortData.Ascending(1) = True
swSortData.ColumnIndex(2) = -1
swSortData.DoNotChangeItemNumber = False
sortSaved = swSortData.SaveCurrentSortParameters
boolstatus = swTableAnnotation.Sort(swSortData)
------------------------------------------------------------------------------------------------
nNumRow = swTableAnnotation.RowCount
j = 8
For i = 1 To nNumRow - 1
sRowStr = ""
sRowStr = sRowStr & swTableAnnotation.Text2(i, j, True) & ","
Debug.Print Left(sRowStr, Len(sRowStr) - 1)
swTableAnnotation.Text2(i, 18, True) = swTableAnnotation.Text2(i, j, True)
Next i
Err1:
Set swApp = Nothing
Set swModel = Nothing
Set swDrawing = Nothing
End Sub
SolidworksApi/macros