'----------------------------------------------------------- 'Bom to FileExcel. ' ' Autor: Ing.Sup.Mec. Pedro Omar S=E1nchez Curbelo (swPeter) ' ' Sevilla. Spain. 27 July 2005 ' '-----------------------------------------------------------
Option Explicit
' PasteSpecial of Excel 'Public Const xlPasteSpecialOperationAdd =3D 2 'Public Const xlPasteAll =3D -4104
' Used to be TYPE_DRAWING Public Const swDocDRAWING =3D 3
Public swViewBOM As SldWorks.BomTable 'Object ' Public nNumRow As Long Public nNumCol As Long
Public xlsApp As Object 'Excel.Application '
Sub main()
Dim swApp As SldWorks.SldWorks 'Object ' Dim swModel As SldWorks.ModelDoc2 'Object ' Dim swDraw As SldWorks.DrawingDoc 'Object ' Dim swView As SldWorks.View 'Object ' Dim swView_Name As String Dim bRet As Boolean Dim I As Long Dim sPathName As String Dim nPos As Long Dim sfolderDoc As String Dim NewBook As Object 'Excel.Workbook ' Dim ObjRange As Object 'Excel.Range ' Dim FileBOM As Boolean Dim ObjExcel As Object Dim Fs As Object Dim iRet As Integer
Set swApp =3D GetObject(, "SldWorks.Application") If Not swApp Is Nothing Then Set swModel =3D swApp.ActiveDoc If Not swModel Is Nothing Then If swModel.GetType =3D swDocDRAWING Then sPathName =3D swModel.GetPathName If sPathName "" Then nPos =3D InStrRev(sPathName, ".") sfolderDoc =3D Left$(sPathName, nPos - 1) Set swDraw =3D swModel Set swView =3D swDraw.GetFirstView Set swView =3D swView.GetNextView Do While Not swView Is Nothing swView_Name =3D swView.Name bRet =3D swModel.Extension.SelectByID2(swView_Name, "DRAWINGVIEW",
0, 0, 0, False, 0, Nothing, 0) If bRet False Then Set swViewBOM =3D swView.GetBomTable If Not swViewBOM Is Nothing Then If AttachBOM Then Set NewBook =3D xlsApp.Workbooks.Add If Not NewBook Is Nothing Then I =3D I + 1 NewBook.SaveAs sfolderDoc & "_BOM " & CStr(I) & ".xls" Set ObjRange =3D NewBook.Sheets(1).Range(NewBook.Sheets(1).Cells(1, 1), NewBook.Sheets(1).Cells(nNumRow, nNumCol)) ObjRange.PasteSpecial 'xlPasteAll, xlPasteSpecialOperationAdd, 0, 0 Set ObjRange =3D Nothing NewBook.Save NewBook.Close Set NewBook =3D Nothing Set xlsApp =3D Nothing FileBOM =3D True End If End If End If End If Set swView =3D swView.GetNextView Loop Set swView =3D Nothing Set swDraw =3D Nothing Set swModel =3D Nothing Else MsgBox "First save this document" End If Else MsgBox "Only Allowed on document DRAWs" End If Else MsgBox "There is no active document" End If Set swApp =3D Nothing Else MsgBox "It was not possible to be connected with SolidWorks" End IfIf FileBOM Then Set Fs =3D CreateObject("Scripting.FileSystemObject") If Not Fs Is Nothing Then If Fs.FileExists(sfolderDoc & "_BOM " & CStr(I) & ".xls") Then iRet =3D MsgBox("Do you want to open the generated file?", vbQuestion Or vbYesNo, "swPeter") If iRet =3D vbYes Then Set ObjExcel =3D GetObject(sfolderDoc & "_BOM " & CStr(I) & ".xls") ObjExcel.Application.Visible =3D True ObjExcel.Parent.Windows(1).Visible =3D True Set ObjExcel =3D Nothing Else MsgBox "Good luck and Health. Good bye. ", vbInformation, "swPeter" End If End If Set Fs =3D Nothing End If End If
End Sub
Public Function AttachBOM() As Boolean
Dim xlsWB As Object 'Excel.Workbook ' Dim xlsSht As Object 'Excel.Worksheet ' Dim ObjRange As Object 'Excel.Range '
If swViewBOM.Attach3 Then nNumRow =3D swViewBOM.GetTotalRowCount nNumCol =3D swViewBOM.GetTotalColumnCount Set xlsApp =3D GetObject(, "Excel.Application") If Not xlsApp Is Nothing Then Set xlsWB =3D xlsApp.ActiveWorkbook If Not xlsWB Is Nothing Then Set xlsSht =3D xlsWB.Sheets(1) If Not xlsSht Is Nothing Then Set ObjRange =3D xlsWB.Sheets(1).Range(xlsWB.Sheets(1).Cells(1, 1), xlsWB.Sheets(1).Cells(nNumRow, nNumCol)) If Not ObjRange Is Nothing Then ObjRange.Copy Set ObjRange =3D Nothing AttachBOM =3D True End If Set xlsSht =3D Nothing Else MsgBox "Error attacking the Sheet in Excel" End If Set xlsWB =3D Nothing Else MsgBox "There is no active Workbook" End If 'Set xlsApp =3D Nothing Else MsgBox "It was not possible to be connected with Excel" End If swViewBOM.Detach Set swViewBOM =3D Nothing Else MsgBox "Error attacking the BOM" End If
End Function