- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hey,
I'm using this i logic code for exporting all part lists on all the sheet that include inside the drawing.
I'm looking to adjust the i logic code to have more specific information in the excel file.
the drawing file :
all the sheets inside the drawing file has 6 part lists, 4 of the part list are the same in the all sheets, 2 part lists are changing every time.
I logic code that I'm using :
Dim oDrawDoc As DrawingDocument = ThisDrawing.Document Dim oSheets As Sheets = oDrawDoc.Sheets 'get the path and name of the drawing file Dim fileName = ThisDoc.PathAndFileName(False) & ".xlsx" If (IO.File.Exists(fileName)) Then Dim result = MessageBox.Show("The file already exists: " & vbCr & vbCr & fileName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) If result = vbYes Then IO.File.Delete(fileName) Else Exit Sub End If Else End If Dim startRow = 1 Dim includeTitle = True Dim PartsListNumber = 1 Dim oPartslist As PartsList For Each sheet As Sheet In oSheets 'Find every sheet in the drawing For Each oPartslist In Sheet.PartsLists 'Find every partslist on the sheet ThisApplication.StatusBarText = "Exporting Sheet " & Sheet.Name & " of " & oSheets.Count & " Please Wait!" ' create a new NameValueMap object Dim oOptions = ThisApplication.TransientObjects.CreateNameValueMap 'specify an existing template file 'to use For formatting colors, fonts, etc 'oOptions.Value("Template") = ThisDoc.Path & "\BOM Template.xlsx" 'specify the Columns To export(all columns need to be in the partslist) 'oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION" 'specify the start cell oOptions.Value("StartingCell") = "A" & startRow 'specify the XLS tab name 'here the file name is used oOptions.Value("TableName") = "PartsList-" & PartsListNumber 'without extension 'choose to include the parts list title row 'in this example "Ye Old List of Parts" is written to the StartingCell oOptions.Value("IncludeTitle") = True 'choose to autofit the column width in the xls file oOptions.Value("AutoFitColumnWidth") = True ' export the Partslist to Excel with options oPartslist.Export(fileName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions) PartsListNumber = PartsListNumber + 1 Next Next Dim Complete = MessageBox.Show("All Done with Partslist Export" & vbCr & vbCr & fileName & vbCr & vbCr _ & "Do you want to open the file?", "Part List Export", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) If Complete = vbYes Then ThisDoc.Launch(fileName) Else Return End If
My issues with this i logic when I'm run it is :
I would like to have the part lists title
Instead of patrslist-1,2,3......
Second issue :
I would like to get the i logic code check the Duplication of repeating parts list in all the sheets and have it once in each excel file.
Thanks
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
1) In your rule you have defined the Table name yourself:
'specify the XLS tab name 'here the file name is used oOptions.Value("TableName") = "PartsList-" & PartsListNumber 'without extension
you need to replace this with the title value of your partslist
'specify the XLS tab name 'here the file name is used oOptions.Value("TableName") = oPartslist.Title
2) When you loop thru the partslists, you could check if there is already a partslist exported with the same file reference. create a new arraylist and check if the file reference already exists in the array. if not, add the file reference to arraylist and continue exporting.
Dim oParents As New ArrayList
If Not oParents.Contains(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) Then oParents.Add(oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
'excute export code ....
end if
Here's a new copy of your copy with these options:
Dim oDrawDoc As DrawingDocument = ThisDrawing.Document Dim oSheets As Sheets = oDrawDoc.Sheets 'get the path and name of the drawing file Dim fileName = ThisDoc.PathAndFileName(False) & ".xlsx" If (IO.File.Exists(fileName)) Then Dim result = MessageBox.Show("The file already exists: " & vbCr & vbCr & fileName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) If result = vbYes Then IO.File.Delete(fileName) Else Exit Sub End If Else End If Dim oParents As New ArrayList Dim startRow = 1 Dim includeTitle = False Dim PartsListNumber = 1 Dim oPartslist As PartsList For Each sheet As Sheet In oSheets 'Find every sheet in the drawing For Each oPartslist In Sheet.PartsLists 'Find every partslist on the sheet If Not oParents.Contains(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) Then oParents.Add(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) ThisApplication.StatusBarText = "Exporting Sheet " & Sheet.Name & " of " & oSheets.Count & " Please Wait!" ' create a new NameValueMap object Dim oOptions = ThisApplication.TransientObjects.CreateNameValueMap 'specify an existing template file 'to use For formatting colors, fonts, etc 'oOptions.Value("Template") = ThisDoc.Path & "\BOM Template.xlsx" 'specify the Columns To export(all columns need to be in the partslist) 'oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION" 'specify the start cell oOptions.Value("StartingCell") = "A" & startRow 'specify the XLS tab name 'here the file name is used oOptions.Value("TableName") = oPartslist.Title '"PartsList-" & PartsListNumber 'without extension 'choose to include the parts list title row 'in this example "Ye Old List of Parts" is written to the StartingCell oOptions.Value("IncludeTitle") = False 'choose to autofit the column width in the xls file oOptions.Value("AutoFitColumnWidth") = True ' export the Partslist to Excel with options oPartslist.Export(fileName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions) PartsListNumber = PartsListNumber + 1 Else Logger.Info(Sheet.Name & ": there is already a partslist exported for file reference " & oPartslist.ReferencedDocumentDescriptor.FullDocumentName) End If Next Next Dim Complete = MessageBox.Show("All Done with Partslist Export" & vbCr & vbCr & fileName & vbCr & vbCr _ & "Do you want to open the file?", "Part List Export", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) If Complete = vbYes Then ThisDoc.Launch(fileName) Else Return End If
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Thank you for your help.
The loop thru the partslists worked very good.
But the Title name rule didn't work.
I got this message :
When you click yes, will get the message one more time.
By clicking NO, will get this error :
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Can you share your drawing? that's easier to help you troubleshoot.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I copied the code from your comment and tried to run the rule.
Second, i tried to run it with out the title rule.
I can't share my drawing, because it's belong to my work company.
Sorry
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
No problem, I checked it again and reproduced the issue. It means that the title of your partslist title is the same. I assumed from your screenshots that your titles where manually changed. I added a new check in the code.
Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheets As Sheets = oDrawDoc.Sheets
'get the path and name of the drawing file
Dim fileName = ThisDoc.PathAndFileName(False) & ".xlsx"
If (IO.File.Exists(fileName)) Then
Dim result = MessageBox.Show("The file already exists: " & vbCr & vbCr & fileName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
If result = vbYes Then
IO.File.Delete(fileName)
Else
Exit Sub
End If
Else
End If
Dim oParents, otitles As New ArrayList
Dim startRow = 1
Dim includeTitle = False
Dim PartsListNumber = 1
Dim oPartslist As PartsList
For Each sheet As Sheet In oSheets 'Find every sheet in the drawing
For Each oPartslist In Sheet.PartsLists 'Find every partslist on the sheet
If Not oParents.Contains(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) Then
oParents.Add(oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
ThisApplication.StatusBarText = "Exporting Sheet " & Sheet.Name & " of " & oSheets.Count & " Please Wait!"
' create a new NameValueMap object
Dim oOptions = ThisApplication.TransientObjects.CreateNameValueMap
'specify an existing template file
'to use For formatting colors, fonts, etc
'oOptions.Value("Template") = ThisDoc.Path & "\BOM Template.xlsx"
'specify the Columns To export(all columns need to be in the partslist)
'oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"
'specify the start cell
oOptions.Value("StartingCell") = "A" & startRow
'specify the XLS tab name
'here the file name is used
If Not otitles.Contains(oPartslist.Title) Then
otitles.Add(oPartslist.Title)
oOptions.Value("TableName") = oPartslist.Title
Else
oOptions.Value("TableName") = oPartslist.Title & PartsListNumber
End If
'choose to include the parts list title row
'in this example "Ye Old List of Parts" is written to the StartingCell
oOptions.Value("IncludeTitle") = False
'choose to autofit the column width in the xls file
oOptions.Value("AutoFitColumnWidth") = True
' export the Partslist to Excel with options
oPartslist.Export(fileName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions)
PartsListNumber = PartsListNumber + 1
Else
Logger.Info(Sheet.Name & ": there is already a partslist exported for file reference " & oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
End If
Next
Next
Dim Complete = MessageBox.Show("All Done with Partslist Export" & vbCr & vbCr & fileName & vbCr & vbCr _
& "Do you want to open the file?", "Part List Export", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
If Complete = vbYes Then
ThisDoc.Launch(fileName)
Else
Return
End If
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report