Vba code voor het kopieren van celwaarde in Word

Status
Niet open voor verdere reacties.
Ik snap het wel maar daarvan is in je code helemaal niets terug te vinden en de enige overeenkomsten tussen je Excel voorbeeld en het Word document is Achternaam en Voornaam.
Plaats beide documenten bij elkaar in dezelfde map.
Open het Excel document, vul de gewenste gegevens in B1 en B2 in en druk dan op je knop.
Bekijk bijlage Checklist test ED.docx
Bekijk bijlage Voorbeeld.xlsm
 
Laatst bewerkt:
Ik snap wat je bedoeld.

Blijkbaar heb ik de code in Module 1 van het originele excel bestand (waar de knop aan gelinkt is) niet mee gekopieerd, sorry.

In deze module staat code:

Code: 
Sub Test()
    Dim wrdApp As Object
    Dim wrdDoc As Object
    Dim Taal As String
    
    Dim Hoofdpad As String
    Dim Zinnetje As String
    
    Taal = UCase(Range("B11"))
    If Taal = "" Then
        MsgBox "Taal ontbreekt!", vbCritical, "Vul een taal in"
        Exit Sub
    End If
    
    Hoofdpad = "C:\Users\Jonathan\Documents\test\"
    
    Set wrdApp = CreateObject(Class:="Word.Application")
    Set wrdDoc = wrdApp.Documents.Open(Filename:=Hoofdpad & Taal & "\intake_" & Taal & ".dotx")
    
    Select Case Taal
        Case "NEDERLANDS":  Zinnetje = "Dit is gemaakt vanuit Excel en komt in zicht!"
        Case "ENGELS":      Zinnetje = "This is made from Excel and comes into view!"
        Case "FRANS":       Zinnetje = "This is made from Excel and comes into view!"
    End Select
    
    
    wrdDoc.Range.InsertAfter Zinnetje
    wrdApp.Visible = True
    wrdApp.WindowState = 1
    wrdApp.Activate
End Sub

Kan jou code hier bij aangemaakt worden?
 
Tuurlijk. Maar volgens mij zijn die paar regeltjes dusdanig simpel dat je dat zelf zou moeten kunnen.
Bestudeer wat het doet en doe er je voordeel mee.
 
Laatst bewerkt:
Kijk uiteraard ook wat ik in het Word document heb gedaan met het toevoegen van velden.
 
Hoi,

Ik ben nu al 2 dagen aan het puzzelen en krijg het niet voor elkaar.
Ik heb geprobeerd om beide codes in elkaar te zetten maar lukt niet. Telkens krijg ik foutmeldingen. De ene keer krijg ik: object niet gevonden, de andere vindt hij het document plots niet.
Volgens mij zit er ook een dubbele verwijzing in, maar als ik die weg haal, werkt er helemaal niks.


Onderstaande code heb ik nu:
Code: 
Sub Intake()
    Dim wrdApp As Object
    Dim wrdDoc As Object
    Dim Taal As String
    
    Dim Hoofdpad As String
    Dim Zinnetje As String
    
    Taal = UCase(Range("B11"))
    If Taal = "" Then
        MsgBox "Taal ontbreekt!", vbCritical, "Vul een taal in"
        Exit Sub
    End If
    
    Hoofdpad = "C:\Users\Jonathan\Documents\test\"
    
    Set wrdApp = CreateObject(Class:="Word.Application")
    Set wrdDoc = wrdApp.Documents.Open(Filename:=Hoofdpad & Taal & "\intake_" & Taal & ".docx")
    
    Select Case Taal
        Case "NEDERLANDS":  Zinnetje = "Dit is gemaakt vanuit Excel en komt in zicht!"
        Case "ENGELS":      Zinnetje = "This is made from Excel and comes into view!"
        Case "FRANS":       Zinnetje = "This is made from Excel and comes into view!"
    End Select
    
    
    wrdDoc.Range.InsertAfter Zinnetje
    wrdApp.Visible = True
    wrdApp.WindowState = 1
    wrdApp.Activate
        Exit Sub

 End Sub
 
    Sub WDopen()
        Set wrdApp = CreateObject(Class:="Word.Application")
        Set wrdDoc = wrdApp.Documents.Open(Filename:=Hoofdpad & Taal & "\intake_" & Taal & ".docx")
    
    VulWDtekst "Achternaam", Range("B1").Value
    VulWDtekst "Voornaam", Range("B2").Value
    
    wrdApp.Visible = True
    wrdApp.Activate
    wrdApp.WindowState = 1
End Sub

Sub VulWDtekst(ccTitle As String, ccText As String)
    Dim ccs As ContentControls
    Dim cct As ContentControl
    
    With wrdDoc
        Set ccs = .SelectContentControlsByTitle(ccTitle)
        Set cct = ccs(1)
        cct.Range.Text = ccText
    End With
End Sub

Wat loopt er fout?
 
De variabelen wrdApp en wrdDoc moet je buiten de Subs declareren.
Zoals ik ook in mijn voorbeeld Excel heb gedaan.

Heb je in je Word document die Content Controls gemaakt?
 
Laatst bewerkt:
Ik heb nu volgende code:
Code: 
Dim wrdApp As Object
Dim wrdDoc As Object

Sub Intake()
    Dim wrdApp As Object
    Dim wrdDoc As Object
    Dim Taal As String
    
    Dim Hoofdpad As String
    Dim Zinnetje As String
    
    Taal = UCase(Range("B11"))
    If Taal = "" Then
        MsgBox "Taal ontbreekt!", vbCritical, "Vul een taal in"
        Exit Sub
    End If
    
     Hoofdpad = "H:\Mijn Documenten\test\Test Word\"
    
    Set wrdApp = CreateObject(Class:="Word.Application")
    Set wrdDoc = wrdApp.Documents.Open(Filename:=Hoofdpad & Taal & "\intake_" & Taal & ".docx")
    
    Select Case Taal
        Case "NEDERLANDS":  Zinnetje = "Dit is gemaakt vanuit Excel en komt in zicht!"
        Case "ENGELS":      Zinnetje = "This is made from Excel and comes into view!"
        Case "FRANS":       Zinnetje = "This is made from Excel and comes into view!"
    End Select
 End Sub
    
Sub VulWDtekst(ccTitle As String, ccText As String)
    Dim ccs As ContentControls
    Dim cct As ContentControl
    
  VulWDtekst "Achternaam", Range("B3").Value
  VulWDtekst "Voornaam", Range("B4").Value
    
    With wrdDoc
        Set ccs = .SelectContentControlsByTitle(ccTitle)
        Set cct = ccs(1)
        cct.Range.Text = ccText
    End With
    wrdDoc.Range.InsertAfter Zinnetje
    wrdApp.Visible = True
    wrdApp.WindowState = 1
    wrdApp.Activate

 End Sub

Hij kan nog steeds het document niet vinden. Terwijl dit toch in de juiste map staat....
Ja ik heb het document aangepast. Alleen kom ik niet verder omdat hij het document niet kan vinden.
Heel bizar...
 
Oke, ik heb nu alle dim's uit de sub gezet.
Als ik de module uitvoer start er een bewerking. Alleen gaat het Word document niet op. Als ik dan rechtstreeks naar het document ga, krijg ik de melding dat het reeds geopend is... nergens is het document in het scherm te vinden.
als ik de module nogmaals uitvoer, krijg ik de foutmelding: wacht tot dat een andere toepassing een OLE bewerking heeft voltooid.

Ik ben misschien enorm dom, maar ik snap er geen fluit meer van.
 
Plaats dan je Word en Excel document eens hier.
 
Ik dacht dat ik het correcte antwoord al een paar dagen gegeven had gegeven, maar dat berichtje is zo te zien verloren gegaan.
Misschien wordt het tijd om het probleem eens op te lossen, want anders zitten we zo aan de 40 berichtjes voor een vrij simpel probleem :). Vergeet daarbij de ContentControls (waarom zou je die hier gebruiken? Die zijn bedoeld voor gebruik binnen Word. Vullen vanuit externe applicaties is veel te lastig). Gebruik DocVariables om tekst over te zetten.
Daarnaast is een wezenlijke denkfout nog steeds aanwezig: je opent een document. Niet doen. Je gebruikte daarvoor eerst een dotx (dat is al helemaal niet goed), en nu een docx, maar dat levert hetzelfde probleem op denk ik. Gebruik dus wél een sjabloon, maar maak een nieuw document op basis van dat sjabloon.
Ik heb de hele handel getest met een Frans sjabloon, dus die variant kun je uitproberen en als basis gebruiken voor de overige velden en talen. De map Test kun je in je eigen >Mijn documenten> neerzetten; de code kijkt dynamisch naar die map. En dan houden we het draadje hopelijk binnen twee pagina's :).
 

Bijlagen

  • jonathan1.zip
    234,2 KB · Weergaven: 49
In de code zoek je de Taal in B11 terwijl deze in B5 staat.
In de code kijk je naar een .docx document terwijl je een.doc hebt.
Je hebt de VulWDtekst regels verplaatst naar de VulWDtekst Sub.
Waarom? Daar horen ze niet.
 
Laatst bewerkt:
Snap ik niet; in je Excel bestand zit nog steeds dezelfde (uiteraard aangepaste) macro:
Code: 
Sub Test()
''Late Binding
''Dim wrdApp As Object, wrdDoc As Object
''    Set wrdApp = CreateObject(Class:="Word.Application")

''Early Binding
Dim wrdApp As Word.Application, wrdDoc As Word.Document
Dim Taal As String, Hoofdpad As String, Zinnetje As String, Sjabloon As String
    
    Taal = StrConv(Range("B5"), vbProperCase)
    If Taal = "" Then
        MsgBox "Taal ontbreekt!", vbCritical, "Vul een taal in"
        Exit Sub
    End If
    
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo Hell
        Set wrdApp = CreateObject("Word.Application")
    End If
    Hoofdpad = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\test\"
    Sjabloon = Hoofdpad & Taal & "\intake_" & Taal & ".dotx"
    
    wrdApp.Visible = True 'Make the application visible to the user (if wanted)
    Set wrdDoc = wrdApp.Documents.Add(Template:=Sjabloon, NewTemplate:=False, DocumentType:=0)
    
    Select Case Taal
        Case "Nederlands":  Zinnetje = "Dit is gemaakt vanuit Excel en komt in zicht!"
        Case "Engels":      Zinnetje = "This is made from Excel and comes into view!"
        Case "Frans":       Zinnetje = "Ceci est fabriqué à partir d'Excel et apparaît!"
    End Select
    
    With wrdDoc
        .Range.InsertAfter Zinnetje
        .Variables("varAchternaam").Value = Cells(1, 2)
        .Variables("varVoornaam").Value = Cells(2, 2)
        .Variables("varAdres").Value = " "
        .Variables("varTelefoon").Value = " "
        .Visible = True
        .Fields.Update
        .WindowState = 1
    ''    .Activate
    End With
    Exit Sub

Hell:
    MsgBox "MS Excel has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: LaunchWord" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
End Sub
Ik heb wél Early Binding gebruikt; tenzij je een specifieke reden hebt om Late Binding te gebruiken, zou ik dat ook zeker doen als ik jou was.
 
Ik heb de code in jouw nieuwe voorbeeld gezet (het Excel bestand dus). En het werkt (nog steeds).
 

Bijlagen

  • jonathan11.zip
    130,5 KB · Weergaven: 63
Een deel van je code werkt.
Hij start het document op maar geneerd de tekst van de cellen niet in het word document, Achternaam, Voornaam, ect.
Tevens krijg ik de melding van foutcode 438.

Ook komt het document niet op de voorgrond te staan.

Wat is er fout?
 
In het document dat ik heb geprepareerd (Frans) heb ik DocVariables aangemaakt (varAchternaam, varVoornaam). Die heb je nodig om in te laten vullen. Waarschijnlijk bestaan ze nog niet in de andere documenten.
 
Ik ben vanmiddag nog even aan het puzzelen geweest en het is gelukt. Alles werkt zoals het moet.
Thx iedereen!
 
Hoi,

Ik loop nog tegen een probleem aan.
De code werkt in mijn testplatform zonder enig probleem. Echter wil ik de module nu in het juiste excel bestand kopieren en hij geeft iedere keer aan dat er een fout is in het ccs as contentcontrols.
Maar als ik dezelfde module laat draaien in het test bestand (kopie van het originele) geeft hij dit probleem niet.

Wat kan hier de oorzaak van zijn?
 
Je geeft iets te weinig informatie; om te beginnen: op welke regel geeft hij de foutmelding?
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan