09-28-2019
08:28 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
09-28-2019
08:28 PM
Hello,
I made sample code that collect the BOMs of the drawing documents which are opened.
Option Explicit
Private Const TempWorkBookName = "TempWorkBook.xlsx"
Private oExcelApp As Excel.Application
Private TempWorkbookFullName As String
Public Sub CollectOpenedIdwBOMs()
' Init WSH and temp path
Dim WSH As Variant
Set WSH = CreateObject("WScript.Shell")
TempWorkbookFullName = WSH.SpecialFolders("Desktop") & "\" & TempWorkBookName
' Setup Excel
Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
oExcelApp.DisplayAlerts = False
Dim oWorkbook As Workbook
Set oWorkbook = oExcelApp.Workbooks.Add
' Create AssyDoc collection
Dim oAssyDocs As ObjectCollection
Set oAssyDocs = CreateAssyDocs
' Collect BOMs into one workbook
MsgBox "Start Step 1"
CollectBOMsFromDocs oAssyDocs, oWorkbook
' Combine worksheets into one sheet
MsgBox "Start Step 2"
CombineWorksheets oWorkbook
' end
oExcelApp.DisplayAlerts = True
Set oExcelApp = Nothing
MsgBox "End"
End Sub
Private Function CreateAssyDocs() As ObjectCollection
Set CreateAssyDocs = ThisApplication.TransientObjects.CreateObjectCollection
Dim oDoc As Document
For Each oDoc In ThisApplication.Documents
If TypeOf oDoc Is DrawingDocument Then
Dim oDrawingDoc As DrawingDocument
Set oDrawingDoc = oDoc
Dim oRefedDoc As Document
Set oRefedDoc = oDrawingDoc.ActiveSheet.DrawingViews(1).ReferencedDocumentDescriptor.ReferencedDocument
If TypeOf oRefedDoc Is AssemblyDocument And oRefedDoc.ComponentDefinition.BOM.StructuredViewEnabled Then
CreateAssyDocs.Add oRefedDoc
End If
End If
Next oDoc
End Function
Private Sub CollectBOMsFromDocs(oAssyDocs As ObjectCollection, oWorkbook As Workbook)
Dim oAssyDoc As AssemblyDocument
For Each oAssyDoc In oAssyDocs
ExportBOMAsWorkbook oAssyDoc
Dim oTempWorkbook As Workbook
Set oTempWorkbook = oExcelApp.Workbooks.Open(TempWorkbookFullName)
oTempWorkbook.Sheets(1).Move After:=oWorkbook.Sheets(1)
Kill TempWorkbookFullName
Next oAssyDoc
End Sub
Private Sub CombineWorksheets(oWorkbook As Workbook)
If oWorkbook.Sheets.Count <= 1 Then
Exit Sub
End If
' Copy title line
oWorkbook.Sheets(2).Rows(1).Copy oWorkbook.Sheets(1).Rows(1)
' Copy all sheets into one
Dim oSheet As WorkSheet
Dim rowIndex As Integer
rowIndex = 2
While oWorkbook.Sheets.Count > 1
Dim r As Range
' Set r = oWorkbook.Sheets(2).Cells(2, 1)
' Set r = Range(r, r.End(xlDown)).EntireRow
Set r = oWorkbook.Sheets(2).Rows("2:" & oWorkbook.Sheets(2).Cells(2, 1).End(xlDown).Row)
r.Copy oWorkbook.Sheets(1).Cells(rowIndex, 1)
rowIndex = rowIndex + r.Rows.Count
oWorkbook.Sheets(2).Delete
Wend
End Sub
Private Sub ExportBOMAsWorkbook(oAssyDoc As AssemblyDocument)
Call oAssyDoc.ComponentDefinition.BOM.BOMViews("Structured").Export(TempWorkbookFullName, kMicrosoftExcelFormat, oAssyDoc.DisplayName)
End SubSee the video also :
Is this code helping you?
=====
Freeradical
Hideo Yamada