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:
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 |