Probleempje met wdGotoBookmark

[Wimpieoh]

Hello,

Onderstaande code drukt brieven voor zij die deelnemen aan de activiteiten, maar over geen email beschikken (geen internetaansluiting dus). Ik wens enkel het eerste voorkomen van de naam vet te drukken, maar dit gaat blijkbaar niet met wdGotoBookmark. Zie hiervoor stukje code in oranje. Bij opgave van .Style.Font.Bold = True wordt heel de brief vet weergegeven, wat niet de bedoeling is. Heb tevens gepoogd in het Word-sjabloon het bookmark-anchor vet te maken; ook zonder succes. Heeft iemand een idee? Alvast bedankt voor uw medewerking.

Option Compare Database
Option Explicit

Sub Activiteit_Zonder()

     On Error GoTo errorHandler
     
     Dim dbs As DAO.Database
     Dim rst As DAO.Recordset
     Dim str1 As String
     Dim str2 As String
          
     Set dbs = CurrentDb
     Set rst = dbs.OpenRecordset(Name:="qryActZonderEmail", Type:=dbOpenDynaset)
    
     Do While Not rst.EOF
        str1 = rst![Naam]
        str2 = rst![ID]
        Call drukActiviteit(str1, str2)
        rst.MoveNext
     Loop
     
errorHandlerExit:
     Exit Sub
     
errorHandler:
     MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
     Resume errorHandlerExit
     
End Sub
     
Sub drukActiviteit(s1 As String, s2 As String)

    On Error GoTo errorHandler

    Dim appWord As Word.Application
    Dim docs As Word.Documents
    Dim doc As Word.Document
    Dim strSaveName As String
    Dim strSaveNamePath As String
    Dim strTemplatePath As String
    Dim strWordTemplate As String
          
    strTemplatePath = "c:/wg/access/accdb/"
    strWordTemplate = "Activiteit.dotx"
    strWordTemplate = strTemplatePath & strWordTemplate
            
    Set appWord = GetObject(, "Word.Application")
    Set docs = appWord.Documents
    Set doc = docs.Add(strWordTemplate)
        
    strSaveName = "Activiteit-" & s1 & ".docx"
    strSaveNamePath = strTemplatePath & strSaveName
    
    [COLOR="DarkOrange"]With appWord.Selection
         .Goto What:=wdGoToBookmark, Name:="Naam"
         .TypeText Text:=s1
[COLOR="Red"]         .Style.Font.Bold = True[/COLOR]
         .Goto What:=wdGoToBookmark, Name:="GSM"
         .TypeText Text:=s2
         .Goto What:=wdGoToBookmark, Name:="Naam2"
         .TypeText Text:=s1
         .Goto What:=wdGoToBookmark, Name:="Naam3"
         .TypeText Text:=s1
         .Goto What:=wdGoToBookmark, Name:="Naam4"
         .TypeText Text:=s1
    End With
[/COLOR]     
    With appWord
         .Visible = True
         .Selection.WholeStory
         .Selection.Fields.Update
         Debug.Print "Going to save as " & strSaveName
         .ActiveDocument.SaveAs strSaveNamePath
         .Activate
         .Selection.EndKey Unit:=wdStory
    End With
    
errorHandlerExit:
    Exit Sub
    
errorHandler:
     If Err = 429 Then
        ' Word is not running; open word with CreateObject
        Set appWord = CreateObject("word.application")
        Resume Next
     Else
        MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
        Resume errorHandlerExit
     End If


End Sub

 

[snb]

Kijk dat is nog eens vernuftige code:
Vermijd select en activate in VBA-code.
Vermijd het overbodige gebruik van variabelen.
Ook Word is object-georiënteerd geprogrammeerd.
En heeft in de VBEditor een uitgebreide hulpfunktie.
Het kan 'iets' korter:

Sub drukActiviteit(s1 As String, s2 As String)
  With GetObject(, "Word.Application").activedocument
     with .Bookmarks("Naam").range
        .text=s1
        .Style.Font.Bold = True
     end with
     .Bookmarks("GSM").range=s2
      For j=2 to 4
        .Bookmarks("Naam" & j).range=s1
      Next
      .ActiveDocument.SaveAs "c:/wg/access/accdb/Activiteit-" & s1 & ".docx"
    End With
Exit Sub

 

[Wimpieoh]

Beste snb,


Dit is weliswaar korter maar zet nog steeds de hele pagina in het vet.


Wimpieoh

 

[snb]

Nu niet meer

Sub drukActiviteit(s1 As String, s2 As String)
  With GetObject(, "Word.Application").activedocument
     with .Bookmarks("Naam").range
        .text=s1
[COLOR="Red"]        .Font.Bold = True[/COLOR]
     end with
     .Bookmarks("GSM").range=s2
      For j=2 to 4
        .Bookmarks("Naam" & j).range=s1
      Next
      .ActiveDocument.SaveAs "c:/wg/access/accdb/Activiteit-" & s1 & ".docx"
    End With
Exit Sub

PS. zet alle automatische funkties van Word uit.