tekst met opmaak VBA

Status
Niet open voor verdere reacties.
D

Dencar77

Gebruiker
Lid geworden
15 mrt 2013
Berichten
131
Dag mede forumleden,

ik stoei met het volgende, recentelijk heb ik VBA code afgemaakt waarbij ik een rapport uit Acces in Word laat opmaken. Nu werkt dit prima totdat ik dacht...Hé, de memovelden in Access wijzig ik naar TEKST MET OPMAAK. En toen kwam mijn probleem boven water. De tekst met opmaak-velden verschijnen nu in HTML codering in mijn Word document (je kent het wel, <div> en <br> dingen). Waarom doet Word (icm Acces natuurlijk) dit? Ik wil graag de tekst met opmaak behouden, maar dan zonder de uiterlijke HTML codes erbij.

Wie kan mij hierbij helpen?


Code: 
Option Compare Database
Option Explicit




    Dim appWord As Word.Application
    Dim newdoc As New Word.Document
    Dim mytable As Table
    
    Dim dbs As DAO.Database
    
    Dim rs As Recordset
    Dim rs1 As Recordset
    Dim rS2 As Recordset
    
    Dim qd As QueryDef
    Dim qd1 As QueryDef
    Dim qd2 As QueryDef
    
    Dim str_fontname As String
    Dim str_Lokatie As String
    




Public Function Regio_Word_Export()

    If TypeName(appWord) <> "Application" Then
        Set appWord = CreateObject("Word.Application")
    End If

    Set dbs = CodeDb()

'Initialisatie
'Het geven van een waarde aan een variabele bij de definitie daarvan.
'Als je van tevoren al weet welke waarde een variabele moet krijgen,
'kun je die meteen bij de declaratie een waarde geven.
'Onderstaand wordt het lettertype voor het rapport gedefinieerd
    str_fontname = "Calibri"

'Hier wordt de locatie weergegeven van de gebruikte template.
'Gevonden template in string plaatsen tbv ophalen in MS Word
'onder een nieuwe naam.
'Nieuwe naam is gerelateerd aan MS Word naamgeving.
'Voorbeeld: Document1, Document2, etc.
    
    Set qd2 = dbs.QueryDefs("qry_WORD_Lokatie")
    Set rS2 = qd2.OpenRecordset
    str_Lokatie = rS2![lokLokatie] & "\" & rS2![lokTemplate]

'De string wordt uitgelezen en de gevonden template wordt in MS Word geopend.
    appWord.Application.Documents.Add str_Lokatie
    appWord.Application.ActiveDocument.PageSetup.Orientation = wdOrientPortrait
    appWord.Application.Visible = True

    With appWord.Application.Selection

'In deze regel wordt de lokatie in het document aangegeven
'waar de export van de data begint.
        appWord.Application.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=2
    
    Set qd1 = dbs.QueryDefs("qryRegio")
    Set rs = qd1.OpenRecordset

    rs.MoveFirst
        Do Until rs.EOF = True

            .Text = vbCrLf
            .Move Count:=2
            .Style = wdStyleNormal
            .Text = rs![disRegio]
            .Font.Bold = True
            .Style = wdStyleHeading1
            .Font.Name = str_fontname
            .Move Count:=1
            .Text = vbCrLf
            .Style = wdStyleNormal
            .Move Count:=1
            .Style = wdStyleNormal
            .Text = vbCrLf
            .Move Count:=3
            With appWord.Application.Selection

            'De query in welke de data zijn opgeslagen wordt aangeroepen.
                Set qd1 = dbs.QueryDefs("qryWaterschap")
                qd1![ps_Regio] = rs![regID]
                Set rs1 = qd1.OpenRecordset
                    
                    Do Until rs1.EOF = True

            'Maak een standaard tabel in WORD.
            '[Herhalend voor iedere pagina].
                        Set mytable = .Tables.Add(Range:=appWord.Application.Selection.Range, NumRows:=14, NumColumns:=2)
                        
                            'De kolombreedtes worden ingesteld
                            With mytable
                                .Columns(1).Width = appWord.CentimetersToPoints(4)
                                .Columns(2).Width = appWord.CentimetersToPoints(15)
                
                            'Samenvoegen van de 1ste rij
                                .Cell(Row:=1, Column:=1).Merge MergeTo:=.Cell(Row:=1, Column:=2)
                            End With
            
            'Start data export naar het WORD document.
                        .Text = rs1![omnOnderhoudsplan]
                        .Font.Bold = True
                        .Font.Size = 12
                        .Style = wdStyleHeading2
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Kavelnummer"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnKavelnummer]), "geen data", (rs1![omnKavelnummer]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Pandnummer"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnPandnummer]), "geen data", (rs1![omnPandnummer]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Straatnaam"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnStraatnaam]), "geen data", (rs1![omnStraatnaam]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Datum controle"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnDatumControle]), "geen data", (Format(rs1![omnDatumControle], "mmmm-yyyy")))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Aandachtspunt"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnAandachtspunt]), "geen data", (rs1![omnAandachtspunt]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Waarnemer"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnWaarnemer]), "geen data", (rs1![omnWaarnemer]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Melder"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnMelder]), "geen data", (rs1![omnMelder]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Buurt"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnBuurt]), "geen data", (rs1![omnBuurt]))
                        .Font.Size = 9
                        .Font.Name = str_fontname

                        .Move Unit:=wdCell, Count:=1
                        .Text = "Aanvangdatum controle"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnAanvangdatum]), "geen data", (rs1![omnAanvangdatum]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Datum einde"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnEinddatum]), "geen data", (rs1![omnEinddatum]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Periodiek onderhoud"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnPeriodiekOnderhoud]), "geen data", (rs1![PeriodiekOnderhoud]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                       
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Algemeen"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnAlgemeen]), "geen data", (rs1![omnAlgemeen]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
                
                        .Move Unit:=wdCell, Count:=1
                        .Text = "Voortgang"
                        .Font.Size = 9
                        .Font.Name = str_fontname
                        .Move Unit:=wdCell, Count:=1
                        .Text = IIf(IsNull(rs1![omnVoortgang]), "geen data", (rs1![omnVoortgang]))
                        .Font.Size = 9
                        .Font.Name = str_fontname
            
                        .MoveDown Unit:=wdLine, Count:=5, Extend:=wdMove
            
                        With appWord.Application.Selection
                            .Collapse Direction:=wdCollapseEnd
                            .InsertBreak Type:=wdPageBreak
                        End With
            
                    rs1.MoveNext
                Loop
            End With
                
'                With appWord.Application.Selection
'                    .Collapse Direction:=wdCollapseEnd
'                    .InsertBreak Type:=wdPageBreak
'                End With
    
        rs.MoveNext
        Loop
    
    'De inhoudsopgave wordt bijgewerkt.
    appWord.ActiveDocument.TablesOfContents(1).Update
    
    'Ga naar de 1ste pagina.
    appWord.Application.Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst

    End With

MsgBox "Rapport 'Onderhoudslogboek' is gegenereerd.", vbInformation, "Waterschap"

End Function
 
Access kan weliswaar opmaak opslaan in een MEMO veld, maar de consequentie is dan wel dat dat in HTML tags gaat. En die zie je als je de inhoud van het veld exporteert naar Word. Niet doen dus :). Of in Word een macro draaien die de codes vertaalt naar de opmaak.
 
Tja, daar kwam ik vandaag dus ook achter :(. Ik kreeg bijna een hartverzakking toen ik die tags overal zag staan. Maar ik heb totaal geen ervaring met het opmaken van Word macro's. Ben wel een Engelstalig boek aan het lezen over Access exporteren naar Word, Excel en zelfs PowerPoint (dacht ik zo uit mn hoofd), maar het is taaie stof moet ik zeggen, vooral omdat het Engelse vakjargon is. Heb jij misschien een voorbeeld van een word macro die dat kan?
 
Als ik je functie zo bekijk snap ik niet waarom je het niet met een MailMerge oplost, maar daar zul je wel je reden voor hebben. Hier staat een oplossing op basis van een mailmerge. Wellicht is dat voldoende reden voor je om je procedure nog eens tegen het licht te houden :).
 
In het verleden heb ik ook wel eens gestoeid om een opgemaakt memo veld met mailmerge te gebruiken.
En kwam tot de volgende oplossing:
  • in het word sjabloon neem ik een code op '<-memo->'
  • Tijdens de mailmerge zet ik dan de focus op het memo veld
  • Kopieer de inhoud dan naar het klembord
  • En in Word vervang ik de code '<-memo->' met de inhoud van het klembord
Dan krijg je zoiets als onderstaande code

Code: 
.ActiveDocument.MailMerge.Execute         'execute mailmerge            
ObjWordApp.Selection.HomeKey Unit:=6      ' = wdStory
            ObjWordApp.Selection.Find.ClearFormatting
            ObjWordApp.Selection.Find.Replacement.ClearFormatting
            With ObjWordApp.Selection.Find
                .Text = "<-memo->"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = 1                             '1 = wdFindContinue
            End With
             If ObjWordApp.Selection.Find.Execute = True Then
            Me.Memo.SetFocus
                DoCmd.RunCommand acCmdCopy
                ObjWordApp.Selection.PasteAndFormat (0)    '= (wdPasteDefault)
            End If
            
            .Documents.Open(PathDocFile).Close SaveChanges:=C_WdDoNotSaveChanges    'Close original mailmerge document
            .ActiveDocument.saveas FileName:=LocUitvoerPath

Deze code werkt dus alleen in een formulier waarbij je de focus naar een memoveld met opmaak kan verplaatsen.

Jan
 
bedankt michel en jan, mailmerge is een onbekend begrip voor mij. Ik heb net al twee verschillende YouTube filmpjes bekeken en nog wat engelstalige uitleg bekeken (oa je link, michel). Maar blijft even tovenarij voor me. Ik heb twee memovelden in de query waar gebruik wordt gemaakt van Tekst met Opmaak.

Jan, is je vermelde code genoeg om dit in mijn word sjabloon te voegen?
 
Als je Jan zijn code bekijkt, zie je dat die ook met MailMerge werkt. Is overigens niks meer of minder dan de Engelse benaming voor <Afdruk Samenvoegen>, en ik kan me eerlijk gezegd niet voorstellen dat een Office gebruiker dat nog nooit gedaan heeft :). Al was het maar omdat het veruit de makkelijkste manier is om gegevens vanuit Access naar Word te halen. Wel zorgen dat je gegevens (Excel, Access) daar geschikt voor zijn, of je moet ook in Word nogal wat toeren uithalen.
Of natuurlijk je rapport gewoon in Access maken, dan heb je nergens last van. Ik kom niet zo heel veel documenten tegen die ik echt op de manier van jou zou moeten maken. Ik maak ze een stuk sneller en handiger in Access zelf.
 
Dencar,

Ter verduidelijking, bij mij staat de code staat in het access programma en niet in het Word sjabloon. Ik 'mailmerge' of 'voegsamen' vanuit het access programma. En dit is niet de complete code om samen te voegen, het ging hier om het trucje
Code: 
Me.Memo.SetFocus
DoCmd.RunCommand acCmdCopy
ObjWordApp.Selection.PasteAndFormat (0)    '= (wdPasteDefault)

Jan
 
Code: 
Sub Remove_All_Tags()
'______________________________________
'
' This VBA macro removes all tags from
' the source code of a web page
' For example, "<b>This text</b>"
' becomes "This text"
' This quick macro works in Word
'______________________________________
'
ActiveDocument.Select
If Selection.Find.Execute("<", 0, 0) Or Selection.Find.Execute("</", 0, 0) = True Then

Do

Selection.Extend (">")
Selection.Delete

ActiveDocument.Select

Loop Until Selection.Find.Execute("<", 0, 0) = False

Else
MsgBox "No < > tag was found"
End If

End Sub

Bovenstaande code heb ik op internet gevonden en deze heb ik als macro in het template verwerkt. Maar deze pakt nogsteeds de tags van HTML. Wat doe ik anders dan de goede manier?
 
Ben er achter gekomen dat wanneer ik de menu Macro's open --> Macro's weergeven --> Remove_all_Tags aanklik en vervolgens op uitvoeren, dan doet de codering het wel. Maar dit wil ik niet elke keer handmatig doen, maar bij het verwerken van het Word document dat de macro dit automatisch doet. Hoe doe ik dat?
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan