我正在尝试使用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
答案 0 :(得分:0)
Selection
对象具有InsertRowsAbove
和InsertRowsBelow
方法。如果您没有指定其他参数,则会添加一行。
objTable.Select
Selection.InsertRowsBelow 5
或
objTable.Rows(objTable.Rows.Count).InsertRowsBelow