Onderstaande code opslaan als
explodePages.bas
• Word starten | ALT + F11 indrukken | CTRL + R
• Rechtermuisknop op
Normal | Import file...
• Selecteer explodePages.bas
• Klik op de save knop

• Sluit de VBA editor af
Nu kan je je document openen (kan trouwens elk document zijn

), vervolgens:
ALT + F8
Selecteer de macro, klik op
Run en ren snel weg
In de code kan je een aantal dingen wijzigen:
ChangeFileOpenDirectory ("E:\GoT\") <- geef hier de directory op waar de bestanden moeten komen
strVoorvoegsel = "Cable ID" <- geef hier de voorvoegsel van je bestandsnaam
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
| Sub explodePages()
' Macro created @ 26-03-2003
' BtM909
Dim varTotalPages As Variant
Dim i, intBrowser As Integer
Dim strVoorvoegsel, strName As String
Application.ScreenUpdating = False
varTotalPages = ActiveDocument.Content.Information(wdActiveEndAdjustedPageNumber)
intBrowser = varTotalPages - 1
ChangeFileOpenDirectory ("E:\GoT\")
strVoorvoegsel = "Cable ID"
Application.Browser.Target = wdBrowsePage
Selection.HomeKey Unit:=wdStory
For i = 1 To intBrowser
Application.Browser.Next
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add Template:="Normal", NewTemplate:=False
Selection.Paste
strName = strVoorvoegsel & i
ActiveDocument.SaveAs FileName:=strName, FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=False, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
ActiveWindow.Close
Next i
'Laatste pagina: pfew :P
strName = strVoorvoegsel & varTotalPages
ActiveDocument.SaveAs FileName:=strName, FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=False, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub |
[
Voor 10% gewijzigd door
BtM909 op 19-06-2003 13:56
. Reden: Wat code aangepast en een lelijke programmeerfout eruit gehaald :P ]