如何使用VBA Access 2007在Word中的表中插入行?

时间:2014-03-18 04:57:57

标签: vba ms-access-2007 access-vba

我正在尝试使用Access 2007 VBA在Word文档的表中插入一行。我已经尝试了ListRows,Rows,Insert,EntireRow.Insert等。我已经找到了Microsoft的2010+以上的帮助但没有任何适用于2007年。我很确定它因为我不明白关于如何正确执行插入的语法。以下是我的代码,任何人都可以帮忙吗?我的Word文档有1个表,其中有1行,有7列。感谢名单!

Public Sub documentBilletingReserve()
    ' Create pointers to Word Document
    Dim objWord As Word.Application
    Dim objDoc As Word.Document 'doc As Word.Document
    Dim bolOpenedWord As Boolean

    ' Get pointer to Word Document
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
    If Err.Number = 429 Then
        ' If Word is not opened, open it
        Set objWord = CreateObject("Word.Application")
        bolOpenedWord = True
    End If

    objWord.Visible = True ' Set this to true if you want to see the document open 
    On Error GoTo 0

    'Create New Blank Document
    Set objDoc = objWord.Documents.Add("Z:\08_Volume Management\ACCESS\EMAILTEMPLATES\BilletingRequest.dotx") 

    'Create Excel Table in Word doc to populate request
    Dim currentRow As Integer
    currentRow = 2
    Dim objRange
    Dim objTable

    Set objRange = objDoc.Range
    'objDoc.Tables.Add objRange, intNoOfRows, intNoOfColumns
    Set objTable = objDoc.Tables(1)
    'objTable.Borders.Enable = False ' Set to true to see the borders
    'objTable.Cell(2, 1).Range.Text = "RM"

    ' Loop through delegates

    ' Pick Names Delegate Names
    Dim finishedSearch As Boolean
    Dim counterDelegate As Integer
    counterDelegate = 2
    finishedSearch = False

    MMRank = DLookup("[Rank]", "ModelManagers", "[ID] = " + CStr(counterDelegate))
    MMFirstName = DLookup("[FirstName]", "ModelManagers", "[ID] = " + CStr(counterDelegate))
    MMLastName = DLookup("[LastName]", "ModelManagers", "[ID] = " + CStr(counterDelegate))

    objTable.Cell(2, 1).Range.InsertAfter Text:="RM"

    ‘************************************************************
    ‘********** INSERT ROW TO TABLE IN WORD HERE
    ‘************************************************************
    Set rowNew = objTable.ListObject.ListRows.Add(AlwaysInsert:=True)
    rowNew.Range.cells(1, 1).Value = MMGender

    objTable.Cell(2, 1).Range.Text = CStr(currentRow - 1)
    objTable.Cell(2, 3).Range.Text = MMRank
    objTable.Cell(2, 4).Range.Text = MMFirstName + " " + MMLastName
    currentRow = currentRow + 1
    ‘************************************************************

    ' This will shift the focus to Word
    'objWord.Activate

    'Save New Document
    'On Error Resume Next

    Dim stringFilename As String
    stringFilename = "Z:\08_Volume Management\ACCESS\EMAILATTACHMENTS\BilletingRequest" + [VolumeName] + ".docx"

    'On Error Resume Next
    objDoc.SaveAs (stringFilename)
    'On Error Resume Next

    'On Error GoTo 0

    'Close and release pointers
    objDoc.Close False 'doc.Close False
    Set objDoc = Nothing
    If bolOpenedWord = True Then
        'Close Word
        objWord.Quit
    End If

    Set objWord = Nothing
End Sub

1 个答案:

答案 0 :(得分:0)

Selection对象具有InsertRowsAboveInsertRowsBelow方法。如果您没有指定其他参数,则会添加一行。

objTable.Select
Selection.InsertRowsBelow 5

objTable.Rows(objTable.Rows.Count).InsertRowsBelow