'******************************************************************************
'Macro description:
'Creates/changes a Configuration's description from a design table.
'For first time run or new configuration requires design table to
'be opened and closed a second time for update to take place.
'Macro works when design table is opened inside SolidWorks or in a new window.
'
'Install instructions:
'From a SolidWorks model, open a design table in a new window.
'From the Excel menu, select Tools, Macro, Visual Basic Editor.
'In the Visual Basic Editor, double click on ThisWorkbook in the Project Explorer window.
'(If the Project Explorer is not visible, select View, Project Explorer from the menu.)
'(If the ThisWorkbook icon is not visible, expand the Microsoft Excel Objects folder.)
'Paste this code into the code window.
'
'Use instructions:
'This macro assumes row two is the header row which contains the design table parameters
'and row three is start of the configuration data.
'Parameter name for configuration description is $DESCRIPTION (not case sensitive) in hopes
'SolidWorks will sometime honor my enhancement request(s) and add this functionality. Because
'$DESCRIPTION is not a recognized parameter, leave a blank column between the $DESCRIPTION
'colum and the end of the last column in the design table so SolidWorks will ignore it.
'Type in a description for each configuration in the $DESCRIPTION column.
'Close the design table. If this is the first time the macro is run, a message will be
'displayed asking you to open and close the design table (A similar message will be displayed
'when a new configuration is added to the table). Open and close the design table to update
'the configuration descriptions.
'
'******************************************************************************
Option Explicit
Dim swApp As Object
Dim swModel As Object
Dim swConfig As Object
Private Sub Workbook_Open()
'get SolidWorks object
Set swApp = GetObject(, "SldWorks.Application")
'get model that design table belongs to in case users changes active document
'(on open is only time can guarantee calling model will be active)
Set swModel = swApp.ActiveDoc
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim yRow As Long, xCol As Long, FoundNew As Boolean
Dim ConfigName As String
'find $Description column
For xCol = 2 To 256
If StrComp(Cells(2, xCol).Value, "$Description", vbTextCompare) = 0 Then Exit For
Next 'xCol
'check if $Description column exists; exit sub if not
If xCol > 256 Then Exit Sub
'check for SolidWorks object
'(this code should only run when macro is first pasted into workbook)
If swApp Is Nothing Then
'display message for first time use of macro
MsgBox "This design table contains configuration description data" & vbLf & _
"that may need to be updated in the model. To preform " & vbLf & _
"update, re-open this design table and then close it again. ", vbOKOnly + vbExclamation, ThisWorkbook.Name
Exit Sub
End If
'update existing configuration descriptions
For yRow = 3 To 65536 'hopefully table never gets this long
'get configuration name from design table
ConfigName = Cells(yRow, 1).Value
'check for end of table
If Trim$(ConfigName) = "" Then
Exit For
Else
'get configuration object
Set swConfig = swModel.GetConfigurationByName(ConfigName)
'check for new configuration
If swConfig Is Nothing Then
'set flag
FoundNew = True
Else
'just update description in model
swConfig.Description = Cells(yRow, xCol).Value
End If
End If
Next 'yRow
'display re-open message if new configurations found
If FoundNew Then
MsgBox swModel.GetTitle & ": " & vbLf & _
" This model's design table will create new configurations that " & vbLf & _
" will need to have the configuration description added to them. " & vbLf & _
" To add, re-open design table and then close again. ", vbOKOnly + vbExclamation, ThisWorkbook.Name
End If
End Sub
