时间戳

首页 > 解决方案 > 无法从 Access VBA 中选择正确的活动文档（单词）

vba - 无法从 Access VBA 中选择正确的活动文档（单词）

问题描述

谢谢阅读。我正在编写一些 VBA 访问，它将数据导出到 1 个 excel 表和 2 个 word 文档。如果我在运行代码时没有打开其他单词文档，那么一切正常。但是，如果另一个 word 实例正在运行，我的一些选择和数据最终会出现在“其他”打开的 word 文档中。我的问题是我似乎无法从我的代码中引用正确的文档。非常欢迎任何帮助！:-) 我已经花了好几天，试图解决这个问题......

错误发生在“Selection.EndKey....”点。我知道这是因为我在 Access 中的 Word 中引用了该选择 - 我似乎无法弄清楚如何正确引用该选择，因此它在“wDoct”文档中进行了操作。选择只取最后一行并使其变为粗体，然后向右移动 1 个 Tab 并插入更多数据。任何其他更好的方法来解决这个问题也非常受欢迎。如您所见，我刚刚开始学习这一点；-) 

Public Sub ExportToWord()


Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wDoct As Word.Document
Dim rs As DAO.Recordset
Dim exApp As Excel.Application
Dim exWb As Excel.Workbook
Dim exWs As Excel.Worksheet
Dim nextrow As Long
Dim rng As Word.Range

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Users\Peter\Documents\testdoc.docm", ReadOnly:=False)
Set wDoct = wApp.Documents.Open("C:\Users\Peter\Documents\Trends.docx")
Set rs = CurrentDb.OpenRecordset("Overall")
Set exApp = New Excel.Application
Set exWb = exApp.Workbooks.Open("C:\Users\Peter\Documents\727TRACKER.xlsx", ReadOnly:=False)
Set exWs = exWb.Worksheets("MIS")


If Not rs.EOF Then rs.MoveLast

wDoc.Bookmarks("name").Range.Text = Nz(rs!Name, "")

nextrow = exWs.Cells(exWs.Rows.Count, "A").End(xlUp).Row + 1 'select last row in tracker
exWs.Range("A" & nextrow).Value = Nz(rs!Name, "")  'insert to last row

wDoct.Content.InsertAfter Text:=vbCr & Nz(rs!Name, "") & "date" 'insert last row in Word
Selection.EndKey Unit:=wdStory  'this is where it fails (select last row in and make bold)
Selection.MoveStart Unit:=wdLine, Count:=-1
Set rng = Selection.Range

With rng.Font
    .Bold = True
End With

Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=vbTab
Selection.Font.Bold = wdToggle
Selection.TypeText Text:=Nz(rs!Name, "")


Set rs = CurrentDb.OpenRecordset("Grades")

If Not rs.EOF Then rs.MoveLast

wDoc.Bookmarks("briefQ").Range.Text = Nz(rs!PlanQ, "")
wDoc.Bookmarks("briefQmin").Range.Text = Nz(rs!PlanQMin, "")

With wDoc.Content.Find
    .Text = "True"
    .Replacement.Text = "X"
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll

End With

With wDoc.Content.Find
    .Text = "False"
    .Replacement.Text = ""
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll

End With

Dim ctlList As Control, strItems As String, index As Integer

Set ctlList = Forms!Grades1!List96

For index = 0 To ctlList.ListCount - 1
 If ctlList.Selected(index) Then
 strItems = strItems & ctlList.Column(0, _
 index) & ";"
 End If
 Next index

wDoc.Bookmarks("type").Range.Text = strItems

wApp.DisplayAlerts = False
wDoc.SaveAs2 "C:\Users\Peter\Documents\" & rs!ID & "_gradesheet.docm"
wDoc.Close
wDoct.Save
wApp.Quit

exApp.DisplayAlerts = False
exWb.Close True

Set exWs = Nothing
Set exWb = Nothing
exApp.Quit
Set exApp = Nothing

Set wApp = Nothing
Set wDoc = Nothing
Set wDoct = Nothing
Set rng = Nothing


End Sub

标签： vbams-access

解决方案

对于任何有兴趣的人，我都使用它来解决它：

wDoct.Content.InsertAfter Text:=vbCr & Nz(rs!name, "") & "date" 'insert last row in          Word
wDoct.Content.InsertAfter Text:=vbTab & "name"
wDoct.Range(Start:=wDoct.Paragraphs.Last.Range.Start,     End:=wDoct.Paragraphs.Last.Range.Start + 10).Bold = True

推荐阅读