[Word/Excel 2016] Mail merge + Macro meenemen?

Pagina: 1
Acties:

Vraag


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Even terug in de tijd. Ik ben bezig met het aantal formulieren wat handmatig ingevuld moet worden te reduceren om dit door de computer te laten doen, in het onderwijs is het nog één grote papierberg. Deze documenten moeten we vervolgens uploaden in een online systeem waarbij we de examendossiers hebben staan. Deze moeten gevuld zijn met een aantal verklaringen en documenten voordat de student z'n diploma mag ontvangen. Allemaal goed en wel maar ik word erg moe van het kopiëren en plakken van gegevens die we netjes in excel-bestanden hebben staan.

Inmiddels is de Mail Merge functie al volop in gebruik. Dat gaat als een malle. Nu kom ik alleen bij de volgende halte: het apart opslaan van documenten. Voor mijzelf lukt dit. Online een VBA macro gevonden, bekeken en verwerkt in mijn Word. Werkt ook prima, bestanden worden netjes apart opgeslagen met de naam die ik ze meegeef. De macro is voor de volledigheid hieronder toegevoegd.

De bedoeling is om alle formulieren dusdanig te maken dat met de Mail Merge functie alle studentgegevens al worden overgenomen uit de excel en dat voor het apart opslaan de macro wordt gebruikt. Bijkomend probleem is dat mijn manager wil dat er voor iedere klas een USB-stick gemaakt wordt zodat dit verder binnen het team te gebruiken is. Wat in dat geval gebeurt is dat de door mij toegevoegde macro niet op een andere computer werkt, omdat die daar simpelweg niet op staat.

Mijn vraag:
Hoe krijg ik het voor elkaar dat een macro mee gaat op iedere USB-stick zodat iedere gebruiker dezelfde macro kan gebruiken. Hoe kan ik het word bestand zo maken dat de macro ingebakken zit?

De boel moet zo "fool proof" mogelijk gemaakt worden zodat collega's maar op een paar knopjes hoeven te klikken om een serie documenten uit Word te toveren die apart worden opgeslagen.


Relevante software en hardware die ik gebruik
Word 2016
Excel 2016
Windows 10

Wat ik al gevonden of geprobeerd heb
* Gezocht naar een mogelijkheid om een macro in een Word document te implementeren. Geen duidelijk resultaat gevonden.
* Op een USB-stick mijn documenten gezet, koppelingen gemaakt voor het mergen en gekeken of ik de macro daar terug kon vinden en kon uitvoeren. Macro's toegestaan in Word uiteraard, maar het mocht niet baten.

De macro om bestanden te splitsen:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub BreakOnSection()
' Select a folder, change the default file save location below so it's not just C:
Dim strFolder As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select the folder into which the documents will be saved."
If .Show = -1 Then
strFolder = .SelectedItems(1) & ""
Else
MsgBox "The documents will be saved in the default document file location."
strFolder = "C:"
End If
End With
ChangeFileOpenDirectory strFolder

'Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection

'A mailmerge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)

'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy

'Create a new document to paste text from clipboard.
Documents.Add
Selection.PasteAndFormat (wdFormatOriginalFormatting)

'Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

'Replaces section breaks with space'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^b"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

DocNum = DocNum + 1
' ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
ActiveDocument.SaveAs
ActiveDocument.Close
'Move the selection to the next section in the document
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Sub Demo()
With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^12[^12^13 ]{1,}"
.Replacement.Text = "^12"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub

Beste antwoord (via sypie op 05-07-2018 23:15)


  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
Aangezien ik in een vrolijke bui ben, en het toch te warm is om echt te werken, en omdat het kan :)
een leuk proof-of-conceptje:

mailmerge zonder mailmerge ;-)


Stel je hebt de volgende gegevens in Excel:
Afbeeldingslocatie: https://tweakers.net/ext/f/OPEV5bONAzf8DMrS4StOuafE/full.png
en die wil je, à la een mailmerge, verwerken in één word-document per regel...

Stel, je word-template document (hier N:\test.docx) zier er als volgt uit:
Afbeeldingslocatie: https://tweakers.net/ext/f/1oBxV4Ti1BlvDN0n6bF8v8vy/full.png
Op relevante plaatse is een bladwijzer (engels: bookmark), met een relevante naam. In de bladwijzer 'voornaam' moet de voornaam van de leerling komen, etc...

Zet in excel de volgende macro:
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Option Explicit

Sub maakWord()

  Dim lonLaatsteRij As Long
  Dim rngData As Range
  Dim strVoornaam As String, strAchternaam As String, strKlas As String
  Dim c As Range
  
  With ActiveSheet
    'bepaal de onderste rij van het actieve excel-werkblad
    lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
    'stel bereik in
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
  End With
  
  For Each c In rngData
    c.Select
    strVoornaam = c.Value
    strAchternaam = c.Offset(0, 1).Value
    strKlas = c.Offset(0, 2).Value
    Call maakWordDocument(strVoornaam, strAchternaam, strKlas)
  Next c
  
End Sub

Private Sub maakWordDocument(strVoornaam As String, strAchternaam As String, strKlas As String)

    'maak een verwijzing naar de Microsoft Word x.5 Object Library!!
    
    Dim wordApp As Object, WordDoc As Object

    On Error Resume Next
    
    'kijk of word al open staat
    Set wordApp = GetObject(, "Word.Application")
    'open word
    If wordApp Is Nothing Then
      'If Not open, open Word Application
      Set wordApp = CreateObject("Word.Application")
    End If
    'toon word (of niet, dan op false)
    wordApp.Visible = False
    'open het 'bron'-bestand
    Set WordDoc = wordApp.Documents.Open("N:\test.docx")

    'bladwijzers invullen
    Call InvullenBladwijzer(wordApp, "voornaam", strVoornaam)
    Call InvullenBladwijzer(wordApp, "achternaam", strAchternaam)
    Call InvullenBladwijzer(wordApp, "klas", strKlas)
    
    'bestand opslaan en alles netjes afsluiten
    wordApp.DisplayAlerts = False
    WordDoc.SaveAs Filename:="N:\" & strVoornaam & strAchternaam, FileFormat:=wdFormatDocument
    WordDoc.Close
    wordApp.Quit
    Set WordDoc = Nothing
    Set wordApp = Nothing
    wordApp.DisplayAlerts = True
    
    On Error GoTo 0


End Sub


Sub InvullenBladwijzer(wordApp As Object, strBladwijzer As String, strTekst As String)

  'tekst invullen in relevante strBladwijzer
  wordApp.Selection.GoTo What:=wdGoToBookmark, Name:=strBladwijzer
  wordApp.Selection.TypeText strTekst

End Sub


EN DRAAIEN MAAARRRRRRR!!

Je krijgt nu één wordbestand per excel-regel (in N:\) met als bestandsnaam de VoornaamAchternaam.docx
Afbeeldingslocatie: https://tweakers.net/ext/f/GBq8GprcTB1TRaAbsU71GWiF/full.png

Met de volgende inhoud:
Afbeeldingslocatie: https://tweakers.net/ext/f/GC4VTp33N6tyEh20QmdN8OSZ/full.png


Het fijne is dat je word helemaal buiten je workflow houdt (draait uiteraard wel op de achtergrond)..
De macro staat in het excel-bronbestand.

Alle reacties


Acties:
  • 0 Henk 'm!

  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
Begrijp ik goed dat je, op basis van inhoud in excel, een aantal word-bestande wilt maken?
1 word-document per rij?

Als je handig bent met VBA zou ik de mailmerge buiten beschouwing laten, en alles direct vanuit een vba in het betreffende excel-document regelen...

Je kunt bladwijzers in de worddocument gebruiken om tekst in te voeren vanuit de excel-rij.

Fubctioneel:
- open excel
- draai de macro, deze doet het volgende:
     voor elke rij in excel:
        1. open het 'lege' wordbestand
        2. vul bladwijzers in het wordbestand in, op basis van data uit de excel-rij
        3. sla het word-document op, gebaseerd op data uit de excel-rij
      volgende rij

Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

Ook, maar om op de vraag terug te komen uit de TS: maak de macro in het document zelf en sla het document op als docm, aka word document met macro's.

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • Beste antwoord
  • 0 Henk 'm!

  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
Aangezien ik in een vrolijke bui ben, en het toch te warm is om echt te werken, en omdat het kan :)
een leuk proof-of-conceptje:

mailmerge zonder mailmerge ;-)


Stel je hebt de volgende gegevens in Excel:
Afbeeldingslocatie: https://tweakers.net/ext/f/OPEV5bONAzf8DMrS4StOuafE/full.png
en die wil je, à la een mailmerge, verwerken in één word-document per regel...

Stel, je word-template document (hier N:\test.docx) zier er als volgt uit:
Afbeeldingslocatie: https://tweakers.net/ext/f/1oBxV4Ti1BlvDN0n6bF8v8vy/full.png
Op relevante plaatse is een bladwijzer (engels: bookmark), met een relevante naam. In de bladwijzer 'voornaam' moet de voornaam van de leerling komen, etc...

Zet in excel de volgende macro:
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Option Explicit

Sub maakWord()

  Dim lonLaatsteRij As Long
  Dim rngData As Range
  Dim strVoornaam As String, strAchternaam As String, strKlas As String
  Dim c As Range
  
  With ActiveSheet
    'bepaal de onderste rij van het actieve excel-werkblad
    lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
    'stel bereik in
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
  End With
  
  For Each c In rngData
    c.Select
    strVoornaam = c.Value
    strAchternaam = c.Offset(0, 1).Value
    strKlas = c.Offset(0, 2).Value
    Call maakWordDocument(strVoornaam, strAchternaam, strKlas)
  Next c
  
End Sub

Private Sub maakWordDocument(strVoornaam As String, strAchternaam As String, strKlas As String)

    'maak een verwijzing naar de Microsoft Word x.5 Object Library!!
    
    Dim wordApp As Object, WordDoc As Object

    On Error Resume Next
    
    'kijk of word al open staat
    Set wordApp = GetObject(, "Word.Application")
    'open word
    If wordApp Is Nothing Then
      'If Not open, open Word Application
      Set wordApp = CreateObject("Word.Application")
    End If
    'toon word (of niet, dan op false)
    wordApp.Visible = False
    'open het 'bron'-bestand
    Set WordDoc = wordApp.Documents.Open("N:\test.docx")

    'bladwijzers invullen
    Call InvullenBladwijzer(wordApp, "voornaam", strVoornaam)
    Call InvullenBladwijzer(wordApp, "achternaam", strAchternaam)
    Call InvullenBladwijzer(wordApp, "klas", strKlas)
    
    'bestand opslaan en alles netjes afsluiten
    wordApp.DisplayAlerts = False
    WordDoc.SaveAs Filename:="N:\" & strVoornaam & strAchternaam, FileFormat:=wdFormatDocument
    WordDoc.Close
    wordApp.Quit
    Set WordDoc = Nothing
    Set wordApp = Nothing
    wordApp.DisplayAlerts = True
    
    On Error GoTo 0


End Sub


Sub InvullenBladwijzer(wordApp As Object, strBladwijzer As String, strTekst As String)

  'tekst invullen in relevante strBladwijzer
  wordApp.Selection.GoTo What:=wdGoToBookmark, Name:=strBladwijzer
  wordApp.Selection.TypeText strTekst

End Sub


EN DRAAIEN MAAARRRRRRR!!

Je krijgt nu één wordbestand per excel-regel (in N:\) met als bestandsnaam de VoornaamAchternaam.docx
Afbeeldingslocatie: https://tweakers.net/ext/f/GBq8GprcTB1TRaAbsU71GWiF/full.png

Met de volgende inhoud:
Afbeeldingslocatie: https://tweakers.net/ext/f/GC4VTp33N6tyEh20QmdN8OSZ/full.png


Het fijne is dat je word helemaal buiten je workflow houdt (draait uiteraard wel op de achtergrond)..
De macro staat in het excel-bronbestand.

Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

breew schreef op donderdag 5 juli 2018 @ 15:35:
Aangezien ik in een vrolijke bui ben, en het toch te warm is om echt te werken, en omdat het kan :)
een leuk proof-of-conceptje
Zullen we het dan maar aan t weer en t poc wijten dat t voor jouw doen best wel lelijke code is? :p

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Lustucru schreef op donderdag 5 juli 2018 @ 15:33:
Ook, maar om op de vraag terug te komen uit de TS: maak de macro in het document zelf en sla het document op als docm, aka word document met macro's.
Dat had ik gedaan, dit docm bestand op mijn USB-stick gezet en op een andere PC geprobeerd. Uiteraard in Word aangegeven dat alle macro's toegestaan moeten worden. Mocht helaas niet baten...
breew schreef op donderdag 5 juli 2018 @ 15:35:
Het fijne is dat je word helemaal buiten je workflow houdt (draait uiteraard wel op de achtergrond)..
De macro staat in het excel-bronbestand.
Deze oplossing ziet er intelligent uit. De manier van benadering is anders dan hoe ik bezig was met denken, meer vanuit Word dan vanuit Excel. Ik ga 'm proberen te implementeren en eventueel met meerdere macro's zodat er verschillende bestanden uitgeperst kunnen worden. Eens kijken of ik dat voor elkaar kan krijgen.

In ieder geval super bedankt voor het meedenken, ook al is het een "quick 'n' dirty oplossing".

@breew Ik krijg een foutmelding: "Een variabele is niet gedefinieerd."
Daarbij wordt deze regel aangeduid:
code:
1
Sub maakWord()

[ Voor 8% gewijzigd door sypie op 05-07-2018 19:04 ]


Acties:
  • 0 Henk 'm!

  • DJMaze
  • Registratie: Juni 2002
  • Niet online
sypie schreef op donderdag 5 juli 2018 @ 14:32:
Deze documenten moeten we vervolgens uploaden in een online systeem waarbij we de examendossiers hebben staan.

... Word ... excel
Holy crap, wordt op scholen nog steeds zo omslachtig gewerkt?
Is er niks die papier en word en excel (alle drie dus) naar de bak van nostalgie en geschiedenis les kan sturen?

Ik weet dat Magister/Blackboard (ofzoiets) er is, maar geen wonder dat leraren klagen dat ze geen privé leven over hebben op deze manier.

Maak je niet druk, dat doet de compressor maar


Acties:
  • 0 Henk 'm!

  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
Lustucru schreef op donderdag 5 juli 2018 @ 18:35:
[...]
Zullen we het dan maar aan t weer en t poc wijten dat t voor jouw doen best wel lelijke code is? :p
alles is uiteraard voor verbetering vatbaar ;-)
maar het werkt... (hier althans)...
sypie schreef op donderdag 5 juli 2018 @ 18:48:
[...]


@breew Ik krijg een foutmelding: "Een variabele is niet gedefinieerd."
Daarbij wordt deze regel aangeduid:
code:
1
Sub maakWord()
Dat is apart, hier loopt de code namelijk gewoon prima.
de foutmelding zegt dat er een variabele wordt gebruikt die niet gedeclareerd is met een DIM-statement...
Maar in mijn voorbeeldcode is dat niet het geval.
Heb je wellicht zelf variabelen toegevoegd (of hun naam gewijzigd)?

Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

breew schreef op donderdag 5 juli 2018 @ 19:43:
alles is uiteraard voor verbetering vatbaar ;-)
maar het werkt... (hier althans)...
Met on error resume next werkt alles, zelfs:

Visual Basic:
1
2
3
4
    On Error Resume Next
    [...]
    Set wordApp = Nothing
    wordApp.DisplayAlerts = True

:P

Of ook een leuke: je hebt nog een worddocument openstaan wat je aan het bewerken bent, draait een Excel macro en weg document. :)

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

sypie schreef op donderdag 5 juli 2018 @ 18:48:
[...]
@breew Ik krijg een foutmelding: "Een variabele is niet gedefinieerd."
Daarbij wordt deze regel aangeduid:
code:
1
Sub maakWord()
Gokje: heb je wel de verwijzing naar de Word Library toegevoegd?
breew schreef op donderdag 5 juli 2018 @ 15:35:
'maak een verwijzing naar de Microsoft Word x.5 Object Library!!
Code ook lezen, niet alleen plakken. :)
breew schreef op donderdag 5 juli 2018 @ 19:43:
de foutmelding zegt dat er een variabele wordt gebruikt die niet gedeclareerd is met een DIM-statement...
Of een constante, uit een andere bibliotheek.

[ Voor 28% gewijzigd door Lustucru op 05-07-2018 20:06 ]

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Lustucru schreef op donderdag 5 juli 2018 @ 19:58:

Of ook een leuke: je hebt nog een worddocument openstaan wat je aan het bewerken bent, draait een Excel macro en weg document. :)
Nee, viel mee. Word was afgesloten.
Lustucru schreef op donderdag 5 juli 2018 @ 20:03:
[...]

Gokje: heb je wel de verwijzing naar de Word Library toegevoegd?

[...]

Code ook lezen, niet alleen plakken. :)


[...]

Of een constante, uit een andere bibliotheek.
Ik heb die "Microsoft Word x.5 Object Library" aangepast naar Word 16.0, die staat wel in de library, x.5 staat er niet (meer) in bij mij.

Het werkt nu bijna, op 1 punt na... Hij gooit alles achter elkaar aan in het originele sjabloondocument. Daar gaat dus iets nog niet helemaal lekker

Acties:
  • 0 Henk 'm!

  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
Lustucru schreef op donderdag 5 juli 2018 @ 19:58:
[...]


Met on error resume next werkt alles, zelfs:

Visual Basic:
1
2
3
4
    On Error Resume Next
    [...]
    Set wordApp = Nothing
    wordApp.DisplayAlerts = True

:P

Of ook een leuke: je hebt nog een worddocument openstaan wat je aan het bewerken bent, draait een Excel macro en weg document. :)
hahhaa.. oeps }:O
handle with care...

Het komt weer pijnlijk naar voren dat ik niet (heel) veel ervaring heb buiten excel-vba.
sypie schreef op donderdag 5 juli 2018 @ 20:16:
Het werkt nu bijna, op 1 punt na... Hij gooit alles achter elkaar aan in het originele sjabloondocument. Daar gaat dus iets nog niet helemaal lekker
je 'loop' gaat mis.. of wellicht is je template 'verpest' bij een paar vastlopers? Open hem eens rechtstreeks in Word?

Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
[b]breew schreef op donderdag 5 juli 2018 @ 20:21:[/
je 'loop' gaat mis.. of wellicht is je template 'verpest' bij een paar vastlopers? Open hem eens rechtstreeks in Word?
Template (een gewoon .docx bestand) netjes gemaakt, bladwijzers dezelfde naam gegeven als in de VBA. Hij blijft alles achter elkaar zetten in het originele bestand.

Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

Ik zei toch al, je hebt wel eens mooiere code geschreven en de TS moet code ook lezen voor hij plakt. :)

Wederom een gokje: TS heeft geen N schijf. SaveAs faalt en door de error resume next wordt het originele bestand afgesloten en opgeslagen. :P

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Lustucru schreef op donderdag 5 juli 2018 @ 20:31:
Ik zei toch al, je hebt wel eens mooiere code geschreven en de TS moet code ook lezen voor hij plakt. :)

Wederom een gokje: TS heeft geen N schijf. SaveAs faalt en door de error resume next wordty het originele bestand afgesloten en opgeslagen. :P
Dat ik geen programmeur ben heb je goed ingeschat. Dat ik geen N-schijf heb klopt ook. Maar gelukkig heb ik die al wel aangepast naar een locatie die ik kan bereiken en waar ik rechten toe heb.

Voor de volledigheid de aangepaste VBA:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Option Explicit

Sub maakWord()

  Dim lonLaatsteRij As Long
  Dim rngData As Range
  Dim strVoornaam As String, strAchternaam As String, strSlber As String
  Dim c As Range
  
  With ActiveSheet
    'bepaal de onderste rij van het actieve excel-werkblad
    lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
    'stel bereik in
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
  End With
  
  For Each c In rngData
    c.Select
    strVoornaam = c.Value
    strAchternaam = c.Offset(0, 1).Value
    strSlber = c.Offset(0, 2).Value
    Call maakWordDocument(strVoornaam, strAchternaam, strSlber)
  Next c
  
End Sub

Private Sub maakWordDocument(strVoornaam As String, strAchternaam As String, strSlber As String)

    'maak een verwijzing naar de Microsoft Word 16.0 Object Library!!
    
    Dim wordApp As Object, WordDoc As Object

    On Error Resume Next
    
    'kijk of word al open staat
    Set wordApp = GetObject(, "Word.Application")
    'open word
    If wordApp Is Nothing Then
      'If Not open, open Word Application
      Set wordApp = CreateObject("Word.Application")
    End If
    'toon word (of niet, dan op false)
    wordApp.Visible = False
    'open het 'bron'-bestand
    Set WordDoc = wordApp.Documents.Open("C:\Users\swf01\Desktop\AkkoordverklaringBPV20172018bookmarks.docx")

    'bladwijzers invullen
    Call InvullenBladwijzer(wordApp, "voornaam", strVoornaam)
    Call InvullenBladwijzer(wordApp, "achternaam", strAchternaam)
    Call InvullenBladwijzer(wordApp, "slber", strSlber)
    
    'bestand opslaan en alles netjes afsluiten
    wordApp.DisplayAlerts = False
    WordDoc.SaveAs Filename:="C:\Users\sfw01\Desktop\" & strVoornaam & strAchternaam, FileFormat:=wdFormatDocument
    WordDoc.Close
    wordApp.Quit
    Set WordDoc = Nothing
    Set wordApp = Nothing
    wordApp.DisplayAlerts = True
    
    On Error GoTo 0


End Sub


Sub InvullenBladwijzer(wordApp As Object, strBladwijzer As String, strTekst As String)

  'tekst invullen in relevante strBladwijzer
  wordApp.Selection.GoTo What:=wdGoToBookmark, Name:=strBladwijzer
  wordApp.Selection.TypeText strTekst

End Sub

Acties:
  • +1 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

Plaats die on error goto 0 eens tussen 36-37, zet regel 43 op true en comment out 53. DAn krijg je wat meer info wat er fout gaat. En denk vast na hoe je dit veilig wilt verspreiden zodat het werkt op elke PC waar je die USB stick insteekt.

Voor de goede orde: mijn gokje blijft staan, al gaat het er niet om dat je geen N-schijf hebt. je hebt geen sfw01\desktop.
sypie schreef op donderdag 5 juli 2018 @ 20:32:
[...]
Maar gelukkig heb ik die al wel aangepast naar een locatie die ik kan bereiken en waar ik rechten toe heb.

Voor de volledigheid de aangepaste VBA:
code:
1
2
    Set WordDoc = wordApp.Documents.Open("C:\Users\swf01\Desktop
    WordDoc.SaveAs Filename:="C:\Users\sfw01\Desktop\" & strVoornaam & strAchternaam,

[ Voor 83% gewijzigd door Lustucru op 05-07-2018 20:59 . Reden: Veilig toegevoegd: F_J_K heeft weer eens groot gelijk ]

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • +1 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

sypie schreef op donderdag 5 juli 2018 @ 18:48:
Uiteraard in Word aangegeven dat alle macro's toegestaan moeten worden.
Noem me een spelbreker :P maar: het is IMHO een slecht idee om anderen aan te leren dat het OK is om zomaar DOCM/XLSM-files te draaien en die instelling dat any macro mag draaien. Zeker als het "fool proof" moet en men dus dit bestand niet van malware zal kunnen onderscheiden. Ga tenminste je certificaat installeren op alle PC's waar het gebruikt gaat worden.

Hint: de combinatie van USB stick, persoonsgegevens van alle scholieren, en by design geen-beveiliging, is niet echt wetmatig.

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

F_J_K schreef op donderdag 5 juli 2018 @ 20:45:
[...]

Noem me een spelbreker :P
Spelbreker! :P Natuurlijk is die USB stick encrypted en staan er ook geen persoonsgegevens op. Alleen maar de macro. Toch?

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • 0 Henk 'm!

  • HenkDePoema
  • Registratie: Oktober 2005
  • Laatst online: 11-09 10:33
F_J_K schreef op donderdag 5 juli 2018 @ 20:45:
[...]

Noem me een spelbreker :P maar: het is IMHO een slecht idee om anderen aan te leren dat het OK is om zomaar DOCM/XLSM-files te draaien en die instelling dat any macro mag draaien. Zeker als het "fool proof" moet en men dus dit bestand niet van malware zal kunnen onderscheiden. Ga tenminste je certificaat installeren op alle PC's waar het gebruikt gaat worden.

Hint: de combinatie van USB stick, persoonsgegevens van alle scholieren, en by design geen-beveiliging, is niet echt wetmatig.
Noem me een taalnazi :P, maar je bedoelt waarschijnlijk 'wettig', als in 'naar de wet'.
Hint: in de context van programmacode is, vanwege het vastliggende algoritme, juist elke onveiligheid een wetmatigheid, helaas!

Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Uiteraard zijn de USB-sticks zwaar encrypted, liggen ze niet in een bureaulade maar in een kluis enz. Alles voor de AVG.

Ik heb mijn issue al gevonden, 2 letters omgedraaid in mijn gebruikersnaam op deze computer. Nu maakt word netjes bestanden aan op volgorde! Netjes.

Nu kan ik naar de volgende stap gaan kijken: het bereik uitbreiden en kijken of ik data uit verschillende kolommen in Word ingevoegd krijg. Mijn excel heeft kolommen van A tot en met BR (op dit moment). Niet alle kolommen zijn in alle documenten nodig. In het ene document heb ik voor- en achternaam nodig, in het andere document hebt ik een cijfer nodig. Enz.

Maar met deze VBA kom ik in ieder geval een heel eind, dit scheelt het hele team in nu al een halve dag werk. Je moet rekenen dat de meeste mensen werkelijk alles met de muis doen en iedere keer weer om hetzelfde knopje zoeken in plaats van sneltoetsen te gebruiken.

Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

In dat geval zou ik toch teruggrijpen op je oorspronkelijke plan. Desnoods in de vorm van een invoegsjabloon dat je kunt ondertekenen en verspreiden, waarmee samenvoegdocumenten 1 voor 1 kunnen worden gemerged en opgeslagen of bv naar een pdf printer worden gestuurd.

Ook een proof-of-concept:

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Explicit

Sub MergeOneByOne()

    On Error GoTo nop

    Dim i As Long
    Dim mDoc As Document
    
    Set mDoc = ActiveDocument
    
    If mDoc.MailMerge.MainDocumentType = wdNotAMergeDocument Then
        MsgBox "Dit is geen mailmergedocument!"
        Exit Sub
    End If
    
    With mDoc.MailMerge.DataSource
        mDoc.MailMerge.Destination = wdSendToNewDocument
        .ActiveRecord = wdFirstDataSourceRecord
        For i = 1 To .RecordCount
            .FirstRecord = .ActiveRecord
            .LastRecord = .ActiveRecord
            mDoc.MailMerge.Execute False
            ActiveDocument.SaveAs2 .DataFields(1) & "_" & .DataFields(2) & ".docx"
            ActiveDocument.Close wdDoNotSaveChanges
            .ActiveRecord = wdNextDataSourceRecord
        Next i
    End With
    
    Exit Sub
nop:
    MsgBox Err.Description
End Sub

[ Voor 4% gewijzigd door Lustucru op 06-07-2018 07:48 ]

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • +1 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Dat is ook zeker een optie. Toch wil ik verder gaan kijken naar de Excel oplossing. Bij nader inzien is dit een goede oplossing omdat collega's slechts 1 document hoeven te bewerken voor alle gegevens. Ik zorg achter de schermen dat alle formulieren die ingevuld moeten worden vanuit de Excel goed staan zodat ze alleen maar op een knop hoeven te klikken om de documenten te maken. Dit lijkt mij het minst moeilijke voor mijn collega's (je moest eens weten...).

Net snel dit in elkaar gefietst, nu alleen nog kijken voor code om bepaalde kolommen in een Word document te proppen.

EDIT: Net al even wat geprobeerd. Zoals het nu lijkt heb ik met de laatste versie van de VBA code genoeg om het een en ander zelf te fixen. Ik weet nu waar ik wat aan moet passen om het voor elkaar te krijgen, vermoed ik. Het enige wat ik zo nog moet doen is meer velden toevoegen die in een document geplaatst moeten worden. Hier verwacht ik weinig problemen, de basis van de VBA code is er.

Afbeeldingslocatie: https://i.imgur.com/QT6yShz.png

[ Voor 24% gewijzigd door sypie op 05-07-2018 22:21 ]


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
@breew Jouw script heeft me écht heel erg geholpen. Ik kan nu "zomaar" verschillende formulieren genereren die ingevuld zijn en wel.

Korte vraag nog: Is het eenvoudig om het te openen bestand én het op te slaan bestand in een relatieve link te doen?

De bedoeling is dat het Excel bestand in de root van een USB-stick komt en dat de bestanden in \Mapnaam\Bestandsnaam.docx geopend worden en dat de ingevulde documenten in diezelfde map weggeschreven worden onder een aangepaste bestandsnaam.

Ik heb daar al wat op gezocht en ik kom uit op dit, maar er gebeurt niks.
code:
1
2
3
4
5
Set WordDoc = wordApp.Documents.Open("\Mapnaam\documentnaam.docx")

En

WordDoc.SaveAs Filename:="ThisWorkbook.Path & \Mapnaam\Documentnaam" & strVoornaam & Space(1) & strAchternaam, FileFormat:=wdFormatDocument

[ Voor 17% gewijzigd door sypie op 07-07-2018 09:50 ]


Acties:
  • +1 Henk 'm!

  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
sypie schreef op zaterdag 7 juli 2018 @ 09:43:
@breew Jouw script heeft me écht heel erg geholpen. Ik kan nu "zomaar" verschillende formulieren genereren die ingevuld zijn en wel.

Korte vraag nog: Is het eenvoudig om het te openen bestand én het op te slaan bestand in een relatieve link te doen?

De bedoeling is dat het Excel bestand in de root van een USB-stick komt en dat de bestanden in \Mapnaam\Bestandsnaam.docx geopend worden en dat de ingevulde documenten in diezelfde map weggeschreven worden onder een aangepaste bestandsnaam.

Ik heb daar al wat op gezocht en ik kom uit op dit, maar er gebeurt niks.
code:
1
2
3
4
5
Set WordDoc = wordApp.Documents.Open("\Mapnaam\documentnaam.docx")

En

WordDoc.SaveAs Filename:="ThisWorkbook.Path & \Mapnaam\Documentnaam" & strVoornaam & Space(1) & strAchternaam, FileFormat:=wdFormatDocument
ThisWorkbook.Path
is inderdaad wat je moet gebruiken... Maar aangezien dat een variabele is, moeten er natuurlijk geen quotes omheen :+

je hebt nu
Visual Basic:
1
WordDoc.SaveAs Filename:="ThisWorkbook.Path & \Mapnaam\Documentnaam" & strVoornaam & Space(1) & strAchternaam, FileFormat:=wdFormatDocument

probeer eens:
Visual Basic:
1
WordDoc.SaveAs Filename:=ThisWorkbook.Path & "\Mapnaam\Documentnaam" & strVoornaam & Space(1) & strAchternaam, FileFormat:=wdFormatDocument

[ Voor 6% gewijzigd door breew op 07-07-2018 12:25 ]


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Check, dat werkt. Super bedankt.

Ik had geen notie van het feit dat de aanhalingstekens bedoeld waren voor variabelen. De locatie van de excel is inderdaad geen variabele, dat bestand loopt niet ineens naar een andere map (als het goed is).

Jammer dat ik niet meerdere antwoorden als beste kan markeren.

Acties:
  • 0 Henk 'm!

  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
sypie schreef op zaterdag 7 juli 2018 @ 12:30:
Check, dat werkt. Super bedankt.

Ik had geen notie van het feit dat de aanhalingstekens bedoeld waren voor variabelen. De locatie van de excel is inderdaad geen variabele, dat bestand loopt niet ineens naar een andere map (als het goed is).

Jammer dat ik niet meerdere antwoorden als beste kan markeren.
Je had deze fout trouwens makkelijk op kunnen sporen door te leren debuggen in VBA. Zeker nu wat wat complexere code gaat schrijven, is dat iets wat je echt moet gaan leren om fouten snel op te kunnen sporen.

Er zijn genoeg tutorials op internet te vinden.
https://www.techonthenet.com/excel/macros/vba_debug2013.php

Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

breew schreef op zaterdag 7 juli 2018 @ 12:37:
[...]


Je had deze fout trouwens makkelijk op kunnen sporen door te leren debuggen in VBA.
En blijkbaar staat on error resume next en vooral on error goto 0 nog altijd op de verkeerde plek.

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Lustucru schreef op zaterdag 7 juli 2018 @ 12:50:
[...]

En blijkbaar staat on error resume next en vooral on error goto 0 nog altijd op de verkeerde plek.
Dit is heel goed mogelijk, ik laat met niet hinderen door enige kennis of het gebrek daar aan.

Wat ik wel vreemd vind ik dat gemaakte macro's niet altijd werken, Excel geeft dan terug dat macro's onvindbaar zijn of misschien zelfs helemaal uitgeschakeld staan. Dit terwijl andere macro's in hetzelfde bestand prima werken.

Op de afbeeldingen staat in de melding de naam Bsa en in de lijst Bsadvies. Dit komt omdat ik tussen het maken van de afbeeldingen wat aan het proberen was geweest. Uiteraard zijn die namen waarmee ik link wel het zelfde, hier ligt het dus niet aan.

De melding die ik krijg en hoe mijn macro lijstje er uit ziet:
Afbeeldingslocatie: https://i.imgur.com/mk6WHoh.png

Mijn lijst ziet er zo uit:
Afbeeldingslocatie: https://i.imgur.com/feEiN6c.png

En dit is hoe ik de namen van de macro's zie wanneer ik ze toe wil wijzen aan een gemaakte knop. Alle macro's worden gestart met een knop die in het Excel document staan:
Afbeeldingslocatie: https://i.imgur.com/RI2y8Ej.png

[ Voor 11% gewijzigd door sypie op 11-07-2018 12:47 ]


Acties:
  • 0 Henk 'm!

  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

sypie schreef op woensdag 11 juli 2018 @ 12:45:
[...]
Dit is heel goed mogelijk, ik laat met niet hinderen door enige kennis of het gebrek daar aan.
Reden temeer om dit ter harte te nemen:
Lustucru schreef op donderdag 5 juli 2018 @ 20:43:
Plaats die on error goto 0 eens tussen 36-37, zet regel 43 op true en comment out 53. DAn krijg je wat meer info wat er fout gaat. [...]
Wat ik wel vreemd vind ik dat gemaakte macro's niet altijd werken, Excel geeft dan terug dat macro's onvindbaar zijn of misschien zelfs helemaal uitgeschakeld staan. Dit terwijl andere macro's in hetzelfde bestand prima werken.
Er is een verschil tussen modulenaam en Subroutine (macro)naam. Ik zie wel modules maar weinig subroutines. Woordje 'Public' voor sub doet wonderen.

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Even een terugkoppeling van mijn kant: Omdat er in ieder geval één VBA was die niet mee wilde werken heb ik de hele boel opnieuw opgezet. Ik was in ieder geval al niet tevreden over mijn eigen excel, ik had een cijferlijst gemaakt voor de collega's om in te vullen die zo'n 70 kolommen breed was. Dat gaan we niet doen. Wat ik nu gedaan heb is per vak een werkblad gemaakt. Op dit werkblad komen in ieder geval de voor- en achternaam vanuit het werkblad waar de studentgegevens staan. Een naam hoeft dus maar 1 keer te worden ingegeven, de rest gaat automatisch.

Vervolgens heb ik een verborgen werkblad gemaakt waarop alle benodigde kolommen verschijnen, deze wordt gevuld vanuit de verschillende werkbladen. In dit verborgen werkblad zitten nog een paar extraatjes zoals teksten die moeten verschijnen in een brief. Deze teksten ga ik de collega's niet mee vermoeien, die zijn voor hen niet interessant.

Uiteindelijk nog een beetje rond gesnuffeld en gevraagd. Een paar kleine aanpassingen gemaakt in de scripts en nu werkt het feilloos. In ieder geval getest op meerdere computers, vanaf dezelfde USB-stick. Later deze week ga ik ongeveer 40 van deze sticks maken die zo door de collega's gebruikt kunnen worden. Meteen na de vakantie heb ik anderhalf uur de tijd gekregen om op de eerste werkdag het hele team hierover instructies te geven. Uiteindelijk valt er niet zoveel te vertellen, wat er achter de schermen gebeurt is voor hen niet interessant. Wat ze moeten weten is wat ze in moeten vullen en waarom... Uiteindelijk deed iedereen zijn administratie ook wel in Excel, maar het was nergens aan gekoppeld en er zaten geen verdere functies aan verbonden, nu dus wel. Deze functies schelen erg veel tijd, ook al zijn er maar 8 documenten per klas aan gekoppeld. Dat scheelt wel het 8 keer overschrijven van 16 namen, klassen, cijfers, studentnummers enz.

De kortste VBA heb ik hieronder even gezet, de rest is veel langer maar werkt verder exact het zelfde:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit

Sub Akkoordverklaring()

  Dim lonLaatsteRij As Long
  Dim rngData As Range
  Dim strVoornaam As String, strAchternaam As String, strSlber As String
  Dim c As Range
  
With Sheets("Cijferlijst")
    lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
End With
  
  For Each c In rngData
    strVoornaam = c.Value
    strAchternaam = c.Offset(0, 1).Value
    strSlber = c.Offset(0, 12).Value
    Call maakWordDocument(strVoornaam, strAchternaam, strSlber)
  Next c
  
End Sub

Private Sub maakWordDocument(strVoornaam As String, strAchternaam As String, strSlber As String)

    'maak een verwijzing naar de Microsoft Word 16.0 Object Library!!
    
    Dim wordApp As Object, WordDoc As Object

    On Error Resume Next
    
    'kijk of word al open staat
    Set wordApp = GetObject("", "Word.Application")
    'open word
    If wordApp Is Nothing Then
      'If Not open, open Word Application
      Set wordApp = CreateObject("Word.Application")
    End If
    'toon word (of niet, dan op false)
    wordApp.Visible = False
    'open het 'bron'-bestand
    Set WordDoc = wordApp.Documents.Open(ThisWorkbook.Path & "Formulieren\Akkoordverklaring.docx")

    'bladwijzers invullen
    Call InvullenBladwijzer(wordApp, "voornaam", strVoornaam)
    Call InvullenBladwijzer(wordApp, "achternaam", strAchternaam)
    Call InvullenBladwijzer(wordApp, "slber", strSlber)
    
    'bestand opslaan en alles netjes afsluiten
    wordApp.DisplayAlerts = False
    WordDoc.SaveAs Filename:=ThisWorkbook.Path & "Akkoordverklaring\Akkoordverklaring " & strVoornaam & Space(1) & strAchternaam, FileFormat:=wdFormatDocumentDefault
    WordDoc.Close
    wordApp.Quit
    Set WordDoc = Nothing
    Set wordApp = Nothing
    'wordApp.DisplayAlerts = True
    
    'On Error GoTo 0


End Sub


Sub InvullenBladwijzer(wordApp As Object, strBladwijzer As String, strTekst As String)

  'tekst invullen in relevante strBladwijzer
  wordApp.Selection.Goto What:=wdGoToBookmark, Name:=strBladwijzer
  wordApp.Selection.TypeText strTekst

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub


Nogmaals bedankt aan de mensen die mij hierbij écht flink vooruit geholpen hebben.

Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Om nog even terug te komen op deze vraagstelling: Het werkt perfect. Het script wat hierboven gegeven is heb ik meermaals toegepast met andere gegevens in andere documenten. Dit scheelt zo onnoemelijk veel tijd voor ons hele team, als mijn manager die besparing netto zou overmaken dan hoef ik nog minder te werken :D

Nu zit ik echter met een vervolgvraag:

Aan de hand van een selectielijst wil ik een handtekening toevoegen aan een document. Dat moet ongeveer zo werken:

Keuze voor persoon 1 moet afbeelding /handtekening1.png invoegen op een aangewezen plek.
Keuze voor persoon 2 moet afbeelding /handtekening2.pnk invoegen op een aangewezen plek.

De link naar de afbeelding kan ik in Excel regelen met zoiets:
ALS cel =naampersoon 1 dan url=/handtekening1.png

Daar kom ik wel uit. Waar ik niet uit kom is hoe ik die link naar de afbeelding dusdanig kan gebruiken dat de afbeelding in het Word document wordt gezet.

De basis voor de gebuikte code is zoals in mijn laatste bericht hierboven, waarvoor ik @breew nog steeds erg dankbaar ben!

Acties:
  • 0 Henk 'm!

  • breew
  • Registratie: April 2014
  • Laatst online: 07:32
sypie schreef op woensdag 11 december 2019 @ 11:43:
[...]
De basis voor de gebuikte code is zoals in mijn laatste bericht hierboven, waarvoor ik @breew nog steeds erg dankbaar ben!
fijn dat je er nog steeds gemak van hebt :)

Acties:
  • 0 Henk 'm!

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Inmiddels wat verder gegaan met proberen.

Wat mij inmiddels lukt is in Excel een dynamische afbeelding laten verschijnen wanneer een bepaalde naam geselecteerd wordt. De juiste handtekening komt dus netjes in Excel te staan.

Wat niet lukt is de afbeelding door middel van een "Bookmark" of "Bladwijzer" in te voegen in het Word document. Alle tekst wordt netjes overgenomen in het Word document maar de afbeelding niet, waarschijnlijk omdat er


Ik heb deze gevonden maar ik heb werkelijk geen idee of en hoe ik deze kan implementeren in de VBA die eerder gegeven is in dit topic.

Iemand die mij de goede kant op kan duwen?

  • sypie
  • Registratie: Oktober 2000
  • Niet online
Mijn laatste vraag moet ik nog wat aanvullen, ik ben er simpelweg nog niet uit.

Het doel:
Het doel is dat ik onder iedere brief de naam van een manager krijg en de bijbehorende handtekening. De naam invullen gaat net als de rest van de bookmarks. Dat gaat goed en werkt uitstekend. De moeilijkheid voor mij zit 'm in het plaatsen van een afbeelding vanuit Excel. In Excel is het een dynamische afbeelding die op iedere ingevulde rij in een kolom wordt gezet, de afbeelding hangt af van de waarde in een andere cel. Ook dit gaat goed in excel.

Waar heb ik hulp bij nodig:
Ik ben niet (en wordt nooit) een programmeur. Aanpassen van bestaande code gaat redelijk, zo lang het maar om string namen gaat maar niet om het programma zelf. Ik ben op zoek naar iemand die mij op de goede weg kan duwen met code of een link waarmee ik per rij in excel een afbeelding in een Word document krijg.

Het excel werkblad ziet er versimpeld zo uit:
Afbeeldingslocatie: https://i.imgur.com/COWeQAe.png

De code die er nu ligt (aangepast aan deze demo):
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit

Sub Managersignature()
'check for last used row in worksheet:
  Dim lonLaatsteRij As Integer, aantalrijenrngData As Integer
  Dim rngData As Range
  Dim strVoornaam As String, strAchternaam As String, strSlber As String
  Dim c As Range
  
With Sheets("manager")
    lonLaatsteRij = 30
        Do Until .Cells(lonLaatsteRij, 1) <> ""
            lonLaatsteRij = lonLaatsteRij - 1
        Loop
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
End With
  'check in columns:
  For Each c In rngData
    strClass = c.Value
    strManager = c.Offset(0, 1).Value
    strSignature = c.Offset(0, 3).Value
    Call maakWordDocument(strClass, strManager, strSignature)
  Next c
  'show number of documents generated:
  MsgBox "Aantal gegenereerde documenten: " & lonLaatsteRij - 1
  
End Sub
'create word document
Private Sub maakWordDocument(strClass As String, strManager As String, strSignature As String)

    'maak een verwijzing naar de Microsoft Word 16.0 Object Library!!
    
    Dim WordApp As Object, WordDoc As Object

    On Error Resume Next
    
    'kijk of word al open staat
    Set WordApp = GetObject("", "Word.Application")
    'open word
    If WordApp Is Nothing Then
      'If Not open, open Word Application
      Set WordApp = CreateObject("Word.Application")
    End If
    'toon word (of niet, dan op false)
    WordApp.Visible = False
    'open het 'bron'-bestand
    Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\document with bookmarks.docx")
    
    'fill the bookmarks
    'bladwijzers invullen
    Call InvullenBladwijzer(WordApp, "class", strClass)
    Call InvullenBladwijzer(WordApp, "manager", strManager)
    Call InvullenBladwijzer(WordApp, "signature", strSignature)
    
    'bestand opslaan en alles netjes afsluiten
    WordApp.DisplayAlerts = False
    WordDoc.SaveAs Filename:=ThisWorkbook.Path & "\document filled with data " & strStudentfirstname & Space(1) & strStudentlastname, FileFormat:=wdFormatDocumentDefault
    WordDoc.Close
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
    'wordApp.DisplayAlerts = True
    
    'On Error GoTo 0


End Sub


Sub InvullenBladwijzer(WordApp As Object, strBladwijzer As String, strTekst As String)

  'tekst invullen in relevante strBladwijzer
  WordApp.Selection.Goto What:=wdGoToBookmark, Name:=strBladwijzer
  WordApp.Selection.TypeText strTekst

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub
Pagina: 1