操作iPart表的行和列 -2

在上一篇文章, 我们学习了如何创建一个iPart Table，并设置了一些行和列。今天我们看看如何对现有的iPart Table进行操作。其实很简单，就是直接对Excel 表处理。

以下代码基于上次创建的iPart，演示了删除第三列，增加一行，删除第二行。

Public Sub test() 
    'Create an iPart table (21 row, 6 columns) 
    CreateNewiPartTable  ' please refer to the last post 
    'Delete the third column 
    DeleteColumn 3 
    'Add a row to the end of the iPart table 
    AddRow 
    'Delete the second row 
    DeleteRow 2 
End Sub 

Private Sub DeleteColumn(indexOfColumn As Integer) 
    Dim oPartDoc As PartDocument 
    Set oPartDoc = ThisApplication.ActiveDocument 
    On Error Resume Next 
    Dim oFactory As iPartFactory 
    Set oFactory = oPartDoc.ComponentDefinition.iPartFactory 
    'Get the iPartTable 
    If Err > 0 Or oFactory Is Nothing Then 
        Exit Sub 
    End If 
    On Error GoTo 0 
    ' get the column by the index 
    Dim column As iPartTableColumn 
    Set column = oFactory.TableColumns.Item(indexOfColumn) 
    If Not column Is Nothing Then 
        Dim oWorkSheet As WorkSheet 
        Set oWorkSheet = oFactory.ExcelWorkSheet 
        Dim oCells As Range 
        Set oCells = oWorkSheet.Cells 
        Dim oCell As Range 
        Set oCell = oWorkSheet.Columns(indexOfColumn) 
        oCell.Delete 
        Dim oWB As WorkBook 
        Set oWB = oWorkSheet.Parent 
        oWB.Save 
        oWB.Close 
    End If 
    MsgBox "delete a column - done!" 
End Sub

Private Sub DeleteRow(indexOfRow As Integer) 
    Dim oPartDoc As PartDocument 
    Set oPartDoc = ThisApplication.ActiveDocument 
    On Error Resume Next 
    Dim oFactory As iPartFactory 
    Set oFactory = oPartDoc.ComponentDefinition.iPartFactory 
    'Get the iPartTable 
    If Err > 0 Or oFactory Is Nothing Then 
        Exit Sub 
    End If 
    On Error GoTo 0 
    Dim row As iPartTableRow 
    Set row = oFactory.TableRows.Item(indexOfRow) 
    If Not row Is Nothing Then 
        row.Delete 
    End If 
    MsgBox "delete a row - done!" 
End Sub 

Private Sub AddRow() 
    Dim oPartDoc As PartDocument 
    Set oPartDoc = ThisApplication.ActiveDocument 
    On Error Resume Next 
    Dim oFactory As iPartFactory 
    Set oFactory = oPartDoc.ComponentDefinition.iPartFactory 
    'Get the iPartTable 
    If Err > 0 Or oFactory Is Nothing Then 
     Exit Sub 
    End If 
    'Get the part number used in the iPart table 
    Dim row As iPartTableRow 
    Set row = oFactory.TableRows.Item(oFactory.TableRows.Count) 
    Dim sPartNumber As String 
    If Not row Is Nothing Then 
        sPartNumber = row.MemberName 
    End If 
    Dim pos As Integer 
    pos = InStrRev(sPartNumber, "-") 
    Dim str As String 
    str = Left(sPartNumber, pos) 
    Dim iNumber As Integer 
    iNumber = Right(sPartNumber, Len(sPartNumber) - pos) 
    'Assume the offset of the parameter's value (between two rows) is 0.5cm 
    Dim offset As Double 
    offset = 0.5 
    Dim oWorkSheet As WorkSheet 
    Set oWorkSheet = oFactory.ExcelWorkSheet 
    Dim oCells As Range 
    Set oCells = oWorkSheet.Cells 
    ' New row's value... 
    If (iNumber + 1) < 10 Then 
        sPartNumber = str + "0" + CStr(iNumber + 1) 
    Else 
        sPartNumber = str + CStr(iNumber + 1) 
    End If 
    Dim oCell As Range 
    Set oCell = oCells.Insert(, True) 
    oCells.Item(row.Index + 2, 1) = sPartNumber 
    oCells.Item(row.Index + 2, 2) = sPartNumber 
    Dim oUM As UnitsOfMeasure 
    Set oUM = oPartDoc.UnitsOfMeasure 
    Dim i As Integer 
    Dim oParameter As Parameter 
    For i = 3 To oCells.Columns.Count 
        Set oParameter = oPartDoc.ComponentDefinition.Parameters.ModelParameters.Item(oCells.Item(1, i).Value) 
        If oParameter.Name <> oPartDoc.ComponentDefinition.Parameters.ModelParameters.Item(4).Name Then 
            oCells.Item(row.Index + 2, i) = oUM.GetStringFromValue(oParameter.Value + offset * (row.Index), oParameter.Units) 
        Else 
            oCells.Item(row.Index + 2, i) = oPartDoc.ComponentDefinition.Parameters.ModelParameters.Item(4).Expression 
        End If 
    Next 
    Set oUM = Nothing 
    Dim oWB As WorkBook 
    Set oWB = oWorkSheet.Parent 
    oWB.Save 
    oWB.Close 
    MsgBox "Add a row - done!" 
End Sub