Ik heb een word bestand van 82 pagina's die ik graag los op wil slaan per pagina. Hierbij moet het format behouden blijven. Ik ben inmiddels met dank aan meerdere fora tot de volgende code gekomen die inderdaad de tekst qua format goed houdt. Mijn probleem is alleen nog dat er bovenaan iedere pagina een afbeelding staat die hij opschuift naar rechts en naar beneden, waardoor ik van 1 pagina naar 2 pagina's ga. De afbeelding staat dus eigenlijk helemaal bovenin over de volledige breedte van het document. De footer neemt hij nu ook niet mee.
De word is gecreëerd vanuit excel, dus het is wellicht ook mogelijk om hem zonder de afbeelding te maken, dan zoek ik een manier om aan 82 documenten dezelfde header (en footer) toe te voegen.
Dank voor jullie hulp
...
De word is gecreëerd vanuit excel, dus het is wellicht ook mogelijk om hem zonder de afbeelding te maken, dan zoek ik een manier om aan 82 documenten dezelfde header (en footer) toe te voegen.
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
| Sub SplitIntoPages() Dim docMultiple As Document Dim docSingle As Document Dim rngPage As Range Dim iCurrentPage As Integer Dim iPageCount As Integer Dim strNewFileName As String Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _ flicker a bit. Set docMultiple = ActiveDocument 'Work on the active document _ (the one currently containing the Selection) Set rngPage = docMultiple.Range 'instantiate the range object iCurrentPage = 1 'get the document's page count iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) Do Until iCurrentPage > iPageCount If iCurrentPage = iPageCount Then rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page) Else 'Find the beginning of the next page 'Must use the Selection object. The Range.Goto method will not work on a page Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 'Set the end of the range to the point between the pages rngPage.End = Selection.Start End If rngPage.Copy 'copy the page into the Windows clipboard Set docSingle = Documents.Add(Template:=ActiveDocument.AttachedTemplate.FullName, Visible:=False) 'create a new document docSingle.Range.PasteAndFormat (wdFormatOriginalFormatting) 'paste the clipboard contents to the new document 'remove any manual page break to prevent a second blank docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:="" 'build a new sequentially-numbered file name based on the original multi-paged file name and path strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") docSingle.SaveAs strNewFileName 'save the new single-paged document iCurrentPage = iCurrentPage + 1 'move to the next page docSingle.Close 'close the new document rngPage.Collapse wdCollapseEnd 'go to the next page Loop 'go to the top of the do loop Application.ScreenUpdating = True 'restore the screen updating 'Destroy the objects. Set docMultiple = Nothing Set docSingle = Nothing Set rngPage = Nothing End Sub |
Dank voor jullie hulp
...
[ Voor 0% gewijzigd door F_J_K op 08-03-2019 13:35 . Reden: Code tag ]