Toon posts:

[VBA/word 2016] Word opsplitsen met behoud van format

Pagina: 1
Acties:

Vraag


Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
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.

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 ]

Alle reacties


Acties:
  • 0 Henk 'm!

  • AcidBanger
  • Registratie: Maart 2008
  • Laatst online: 10-10 21:06
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub splitter()

Dim Counter As Long, Source As Document, Target As Document
Set Source = ActiveDocument
Selection.HomeKey Unit:=wdStory
Pages = Source.BuiltInDocumentProperties(wdPropertyPages)
Counter = 0
While Counter < Pages
    Counter = Counter + 1
    DocName = "Page" & Format(Counter)
    Source.Bookmarks("\Page").Range.Cut
    Set Target = Documents.Add
    Target.Range.Paste
    Target.SaveAs FileName:=DocName
    Target.Close
Wend
End Sub


Probeer dit eens, maak voor de zekerheid even een kopie van je document.
Hij slaat die pagina's apart op in dezelfde map ;)

[ Voor 14% gewijzigd door AcidBanger op 08-03-2019 11:28 ]


Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
Met deze code maakt hij helaas nogsteeds 1.5 pagina van mijn 1 pagina. Hij verplaatst nogsteeds de afbeelding waardoor alles naar onder schuift en behoudt ook niet de opmaak van het originele document

Acties:
  • 0 Henk 'm!

  • Room42
  • Registratie: September 2001
  • Niet online
Check dan de verschillen tussen de twee documenten. Wat zijn de verschillen in opmaak, marges, etc., etc. En/of gebruik het huidige document als template voor Documents.Add (zie de documentatie).

"Technological advancements don't feel fun anymore because of the motivations behind so many of them." Bron


Acties:
  • 0 Henk 'm!

  • AcidBanger
  • Registratie: Maart 2008
  • Laatst online: 10-10 21:06
Wil je echt aparte word documenten of mag PDF ook :D ?

https://www.ilovepdf.com/split_pdf

Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
De afbeelding wordt een stuk naar onder gezet, dus de marge die hij altijd vrijhoudt voor als je een nieuw document start, en een stukje naar rechts, maar begint daar wel voor de marge waar de rest van het document op uitgelijnd is.

Ja het moeten aparte word documenten blijven, ze moeten nog aangepast kunnen worden.

Ik gebruik al het huidige document als template, en dat gaat in mijn code nu dus ook goed qua tekst, alleen de afbeelding nog niet
Set docSingle = Documents.Add(Template:=ActiveDocument.AttachedTemplate.FullName, Visible:=False) 'create a new document
docSingle.Range.PasteAndFormat (wdFormatOriginalFormatting)

Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

offtopic:
Ik heb je topicstart iets aangepast: de code voorzien van code tags. Het zou nog iets leesbaarder worden als je de originele indenting (spaties / tabs) in je eigen code er terug zet.


Als een plaatje moeilijk doet: haal het plaatje uit het origineel en zet het via VBA op de juiste plaats.

Misschien wil je trouwens ook opslaan als .docx ipv .doc :P

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

Pagina: 1