i want to change part list width of all collumns in idw via vba

[k14348]

Hi,

  I have a idw file with 50 Nos. of sheets. Every sheet there is a part list which is ununiform. i want to edit the part list collumn width via vab. i already have revision table width program. i'm attaching that for your reference.

Sub Change_Revision_table_width()
Dim oDoc As Document
Dim oSheet As Sheet
Dim oRevisionTables As RevisionTable
Dim oRevisionTableColumn As RevisionTableColumn
Dim oColumnName As String
Dim oWidth As Double
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType = kDrawingDocumentObject Then
    Set oSheet = oDoc.ActiveSheet
    oSheet.Activate
    For Each oRevisionTables In oSheet.RevisionTables
        For Each oRevisionTableColumn In oRevisionTables.RevisionTableColumns
        oColumnName = oRevisionTableColumn.Title
        If oColumnName = "Rev." Then ' <--- You Can change the column name in here to what ever column you need
            oRevWidth = ".8"
            oRevisionTableColumn.Width = oRevWidth
        End If
        If oColumnName = "Cpy Rev" Then ' <--- You Can change the column name in here to what ever column you need
            oCpyRevWidth = "1.2"
            oRevisionTableColumn.Width = oCpyRevWidth
        End If
        If oColumnName = "Status" Then ' <--- You Can change the column name in here to what ever column you need
            oStatusWidth = "1.8"
            oRevisionTableColumn.Width = oStatusWidth
        End If
        If oColumnName = "Rev. Date" Then ' <--- You Can change the column name in here to what ever column you need
            oRevDateWidth = "1.8"
            oRevisionTableColumn.Width = oRevDateWidth
        End If
        If oColumnName = "Revision Description" Then ' <--- You Can change the column name in here to what ever column you need
            oRevDesWidth = "4.4"
            oRevisionTableColumn.Width = oRevDesWidth
        End If
        If oColumnName = "Issued by" Then ' <--- You Can change the column name in here to what ever column you need
            oIssuedWidth = "2.0"
            oRevisionTableColumn.Width = oIssuedWidth
        End If
        If oColumnName = "Reviewed by" Then ' <--- You Can change the column name in here to what ever column you need
            oReviewedWidth = "2.0"
            oRevisionTableColumn.Width = oReviewedWidth
        End If
        If oColumnName = "Appr. ENG" Then ' <--- You Can change the column name in here to what ever column you need
            oApprWidth = "2.0"
            oRevisionTableColumn.Width = oApprWidth
        End If
        If oColumnName = "Appr. PMT/OPS" Then ' <--- You Can change the column name in here to what ever column you need
            oApprPMTWidth = "2.0"
            oRevisionTableColumn.Width = oApprPMTWidth
        End If
        If oColumnName = "Part. Accept." Then ' <--- You Can change the column name in here to what ever column you need
            oPartaccWidth = "2.0"
            oRevisionTableColumn.Width = oPartaccWidth
        End If
        Next
    Next
Else
    MsgBox "The Selected document is not a drawing document please select a drawing document and continue", vbOKOnly, "Edit Revision Table  Column Width:"
    Exit Sub
End If
End Sub

Thank you,

Regards,

karthikeyan M

+91-9894814348

[Owner2229]

Hi, first here is your RevisionTable rule simplified:

Sub Change_Revision_table_width()
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType <> kDrawingDocumentObject Then
    MsgBox "The Selected document is not a drawing document please select a drawing document and continue", vbOKOnly, "Edit Revision Table  Column Width:"
    Exit Sub
End If
Dim oSheet As Sheet
Set oSheet = oDoc.ActiveSheet
oSheet.Activate
Dim oRevisionTable As RevisionTable
For Each oRevisionTable In oSheet.RevisionTables
    Dim oColumn As RevisionTableColumn   
    For Each oColumn In oRevisionTable.RevisionTableColumns
        Dim oWidth As Double
        Dim oColumnName As String
        oColumnName = oColumn.Title
        Select Case oColumnName
        Case "Rev.":                 oWidth = ".8"
        Case "Cpy Rev":              oWidth = "1.2"
        Case "Status":               oWidth = "1.8"
        Case "Rev. Date":            oWidth = "1.8"
        Case "Revision Description": oWidth = "4.4"
        Case "Issued by":            oWidth = "2.0"
        Case "Reviewed by":          oWidth = "2.0"
        Case "Appr. ENG":            oWidth = "2.0"
        Case "Appr. PMT/OPS":        oWidth = "2.0"
        Case "Part. Accept.":        oWidth = "2.0"
        Case Else: Continue For
        End Select
        oColumn.Width = oWidth
    Next oColumn
Next oRevisionTable
End Sub

Second, here is the rule for the part lists:

Sub Change_PartLists_Width()
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType <> kDrawingDocumentObject Then
    MsgBox "The Selected document is not a drawing document please select a drawing document and continue", vbOKOnly, "Edit Revision Table  Column Width:"
    Exit Sub
End If
Dim oSheet As Sheet
For Each oSheet In oDoc.Sheets
    oSheet.Activate
    Dim oPartList As PartList
    For Each oPartList In oSheet.PartLists
        Dim oColumn As PartsListColumn
        For Each oColumn In oPartList.PartsListColumns
            Dim oWidth As Double
            Dim oColumnName As String
            oColumnName = oColumn.Title
            ' Specify your columns here, one row per column
            Select Case oColumnName
            Case "Rev.":                 oWidth = ".8"
            Case "Cpy Rev":              oWidth = "1.2"
            Case "Status":               oWidth = "1.8"
            Case "Rev. Date":            oWidth = "1.8"
            Case "Revision Description": oWidth = "4.4"
            Case "Issued by":            oWidth = "2.0"
            Case "Reviewed by":          oWidth = "2.0"
            Case "Appr. ENG":            oWidth = "2.0"
            Case "Appr. PMT/OPS":        oWidth = "2.0"
            Case "Part. Accept.":        oWidth = "2.0"
            Case Else: Continue For
            End Select
            oColumn.Width = oWidth
        Next oColumn
    Next oPartList
Next oSheet
End Sub

[k14348]

Hi,

  Thanks for quick reply. It's showing some error. Error file attached in this mail.

-karthikeyan M

Whatsapp +91-9962356080

[Owner2229]

Try to place this in front of the sub:

Imports Inventor
Sub ...

If it won't help, use this:

Inventor.PartList

[k14348]

Sorry not working..

[Owner2229]

Sorry, my mistake. It should be "PartsList" instead of "PartList".

Here's the corrected version:

Sub Change_PartLists_Width()
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType <> kDrawingDocumentObject Then
    MsgBox "The Selected document is not a drawing document please select a drawing document and continue", vbOKOnly, "Edit Revision Table  Column Width:"
    Exit Sub
End If
Dim oSheet As Sheet
For Each oSheet In oDoc.Sheets
    oSheet.Activate
    Dim oPartsList As PartsList
    For Each oPartsList In oSheet.PartsLists
        Dim oColumn As PartsListColumn
        For Each oColumn In oPartsList.PartsListColumns
            Dim oWidth As Double
            Dim oColumnName As String
            oColumnName = oColumn.Title
            ' Specify your columns here, one row per column
            Select Case oColumnName
            Case "Rev.":                 oWidth = ".8"
            Case "Cpy Rev":              oWidth = "1.2"
            Case "Status":               oWidth = "1.8"
            Case "Rev. Date":            oWidth = "1.8"
            Case "Revision Description": oWidth = "4.4"
            Case "Issued by":            oWidth = "2.0"
            Case "Reviewed by":          oWidth = "2.0"
            Case "Appr. ENG":            oWidth = "2.0"
            Case "Appr. PMT/OPS":        oWidth = "2.0"
            Case "Part. Accept.":        oWidth = "2.0"
            Case Else: Continue For
            End Select
            oColumn.Width = oWidth
        Next oColumn
    Next oPartsList
Next oSheet
End Sub

[k14348]

Hi,

It's not working Error file attached.

[Owner2229 · Accepted solution]

So, apparently VBA doesn't support "Continue For", so we have to do it another way:

Sub Change_PartLists_Width()
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType <> kDrawingDocumentObject Then
    MsgBox "The Selected document is not a drawing document please select a drawing document and continue", vbOKOnly, "Edit Revision Table  Column Width:"
    Exit Sub
End If
Dim oSheet As Sheet
For Each oSheet In oDoc.Sheets
    oSheet.Activate
    Dim oPartsList As PartsList
    For Each oPartsList In oSheet.PartsLists
        Dim oColumn As PartsListColumn
        For Each oColumn In oPartsList.PartsListColumns
            Dim oWidth As Double
            Dim oColumnName As String
            oColumnName = oColumn.Title
            ' Specify your columns here, one row per column
            Select Case oColumnName
            Case "Rev.":                 oWidth = 0.8
            Case "Cpy Rev":              oWidth = 1.2
            Case "Status":               oWidth = 1.8
            Case "Rev. Date":            oWidth = 1.8
            Case "Revision Description": oWidth = 4.4
            Case "Issued by":            oWidth = 2
            Case "Reviewed by":          oWidth = 2
            Case "Appr. ENG":            oWidth = 2
            Case "Appr. PMT/OPS":        oWidth = 2
            Case "Part. Accept.":        oWidth = 2
            Case Else:                   oWidth = 0
            End Select
            If oWidth > 0 Then oColumn.Width = oWidth
        Next oColumn
    Next oPartsList
Next oSheet
End Sub

You can apply the same change for the revisited "Change_Revision_table_width" sub.

[k14348]

Hi,

   Its working thanks. Can i have ur mail id.

-karthikeyan M

whatsapp +91-9962356080

[Owner2229]

You mean my email? Sure:

*MyForumNick*@gmail.com