Спасибо за чтение. Я пишу некоторые VBA в доступе, который экспортирует данные в 1 лист Excel и 2 документа Word. Если у меня нет других слов, открытых при запуске кода, все работает. Но если выполняется другой экземпляр слова, некоторые из моих выборов и данных попадают в «другой» документ с открытым словом. Моя проблема в том, что я не могу ссылаться на правильный документ из моего кода. Любая помощь очень, очень приветствуется! :-) Я потратил несколько дней, пытаясь выяснить это ...
Ошибка возникает в точке "Selection.EndKey ....". Я знаю, что это потому, что я ссылаюсь на этот выбор в Word из Access - я просто не могу понять, как правильно ссылаться на этот выбор, поэтому он делает это в документе "wDoct". Выделение занимает только последнюю строку и выделяется жирным шрифтом, затем перемещается на 1 вкладку вправо и добавляет дополнительные данные. Любые другие и более эффективные способы решения этой проблемы также приветствуются. Я только начинаю изучать это, как вы можете видеть ;-)
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