VBA编辑构建块中的书签

时间:2016-03-04 14:48:01

标签: vba ms-access ms-word access-vba

我有一个Access项目,可以从模板创建word文档。我在模板中使用buildingBlocks。每个buildingBlock都有一个书签。我试图弄清楚如何从数据库中替换带有文本的书签。这是我的代码:

Private Sub Label87_Click()
    Screen.MousePointer = 11
    Dim objWord As Word.Application
    Dim PauseTime, Start, Timer As Integer
    Dim wrkCurrent As DAO.Workspace

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False 'True is visible

    Dim sql As String
    sql = "Some SQL Select COde"
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Set wrkCurrent = DBEngine.Workspaces(0)
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(sql)

    objWord.Documents.Add ("C:\test\myTemplate.docx")
    If (Not rst.EOF) Then
        With rst
            Do Until .EOF
        On Error GoTo Trans_Error
        Dim objBB As BuildingBlock
        Dim objTemplate As Template
        Dim bookMark As bookMark

        Set objTemplate = objWord.ActiveDocument.AttachedTemplate
        Set objBB = objTemplate.BuildingBlockEntries("MyBB")

        objBB.Insert objWord.Selection.Range, RichText:=True            
        objWord.ActiveDocument.Bookmarks("BM_in_BB").Select
        'error occurs here, where I try to change the text
        objWord.ActiveDocument.Selection.Text = "A Test" 


             .MoveNext
            Loop
        End With
    End If

    objWord.ActiveDocument.SaveAs ("C:\test\MyNewDocument.docx")
    objWord.PrintOut
    objWord.Quit
    Set objWord = Nothing
    Screen.MousePointer = 0
Trans_Exit:
    On Error Resume Next
    Set dbs = Nothing
    objWord.Quit
    Set objWord = Nothing
    Screen.MousePointer = 0
    Exit Sub
Trans_Error:
    MsgBox Err.description
        Resume Trans_Exit    

End Sub

0 个答案:

没有答案