I want to delete certain pages from a Word doc.
To do this I used the code from
https://www.extendoffice.com/documents/word/5503-word-delete-multiple-pages.html
Sub DeletePagesInDoc()
Dim xRange As Range
Dim xPage As String
Dim xDoc As Document
Dim xArr
Dim I, xSplitCount As Long
Application.ScreenUpdating = False
Set xDoc = ActiveDocument
xPage = InputBox("Enter the page numbers of pages to be deleted: " & vbNewLine & _
"use comma to separate numbers", "KuTools for Word", "")
xArr = Split(xPage, ",")
xPageCount = UBound(xArr)
For I = xPageCount To 0 Step -1
Selection.GoTo wdGoToPage, wdGoToAbsolute, xArr(I)
xDoc.Bookmarks("\Page").Range.Delete
Next
Application.ScreenUpdating = True
End Sub
However, I receive the following error message:
Run-time error '5904':
Cannot edit Range.
This line produces the error:
xDoc.Bookmarks("\Page").Range.delete
I am sure I entered the pagenumbers correctly (separated by commas, and without spaces)
EDIT: mysteriously, the error solved itsself and no longer appears now! Thanks for the replies.
Related
My Task
Split a Word document into multiple parts based on a delimiter while preserving the text format.
Where I am?
I tried a basic example with one document but without an array and it worked.
Option Explicit
Public Sub CopyWithFormat()
Dim docDestination As Word.Document
Dim docSource As Word.Document
Set docDestination = ActiveDocument
Set docSource = Documents.Add
docSource.Range.FormattedText = docDestination.Range.FormattedText
docSource.SaveAs "C:\Temp\" & "test.docx"
docSource.Close True
End Sub
Where do I stuck?
I put the whole document into an array and loop through it. Right not I get an error 424 - Object necessary on this line:
docDestination.Range.FormattedText = arrNotes(I).
I also tried these four variants without luck:
docDestination.Range.FormattedText = arrNotes(I).Range.FormattedText
docDestination.Range.FormattedText = arrNotes(I).FormattedText
docDestination.Range.FormattedText = arrNotes.Range.FormattedText(I)
docDestination.Range.FormattedText = arrNotes.FormattedText(I)
Could you please help and point me into the right direction on how to access the array properly?
My Code
Option Explicit
Sub SplitDocument(delim As String, strFilename As String)
Dim docSource As Word.Document
Dim docDestination As Word.Document
Dim I As Long
Dim X As Long
Dim Response As Integer
Dim arrNotes
Set docSource = ActiveDocument
arrNotes = Split(docSource.Range, delim)
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set docDestination = Documents.Add
docDestination.Range.FormattedText = arrNotes(I) 'throws error 424
docDestination.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "0000")
docDestination.Close True
End If
Next I
End Sub
Sub test()
'delimiter & filename
SplitDocument "###", "Articles "
End Sub
Range.FormattedText returns a range object. The Split function, on the other hand, returns an array of strings which don't include formatting. Therefore your code should find the portion of the document you wish to copy and assign that part's FormattedText to a variable declared as Range. That variable could then be inserted into another document.
Private Sub CopyRange()
Dim Src As Range, Dest As Range
Dim Arr As Range
Set Src = Selection.Range
Set Arr = Src.FormattedText
Set Dest = ActiveDocument.Range(1, 1)
Dest.FormattedText = Arr
End Sub
The above code actually works. All you would need to do is to find a way to replace the Split function in your concept with a method that identifies ranges in the source document instead of strings.
Book endnotes often forgo superscript numbers for page numbers. E.g., instead of
Abe Lincoln was assassinated with a pistol.^33
:
33. A single-shot derringer pistol.
books by several authors write
Abe Lincoln was assassinated with a pistol.
:
Page 297. Abe Lincoln was shot single-shot derringer pistol.
Word doesn't have this feature, so I believe it would have to be a Macro. I came up with simple code below that loops through all of the endnotes and adds
"Page ???. "
before each endnote, but what does "???" need to be to correctly insert the page number in my manuscript that the citation's located on?
Sub RedefineExistingEndNotes()
Dim fn As Endnote
For Each fn In ActiveDocument.Endnotes
fn.Range.Paragraphs(1).Range.Font.Reset
fn.Range.Paragraphs(1).Range.Characters(1).InsertBefore "Page" & "???" & " - "
Next fn
End Sub
Try the below VBA code:
Sub InsertPageNumberForEndnotes()
Dim endNoteCount As Integer
Dim curPageNumber As Integer
If ActiveDocument.Endnotes.Count > 0 Then
For endNoteCount = 1 To ActiveDocument.Endnotes.Count
Selection.GoTo What:=wdGoToEndnote, Which:=wdGoToAbsolute, Count:=endNoteCount
curPageNumber = Selection.Information(wdActiveEndPageNumber)
ActiveDocument.Endnotes(endNoteCount).Range.Select
ActiveDocument.Application.Selection.Collapse (WdCollapseDirection.wdCollapseStart)
ActiveDocument.Application.Selection.Paragraphs(1).Range.Characters(1).InsertBefore "Page " & CStr(curPageNumber) & " - "
Next
End If
End Sub
An alternative might be to use PAGEREF fields and hide the endnote references, e.g.
Sub modifyEndNotes()
Const bookmarkText As String = "endnote"
Dim en As Word.Endnote
Dim rng As Word.Range
For Each en In ActiveDocument.Endnotes
en.Reference.Bookmarks.Add bookmarkText & en.Index
en.Reference.Font.Hidden = True
Set rng = en.Range
rng.Paragraphs(1).Range.Font.Hidden = True
rng.Collapse WdCollapseDirection.wdCollapseStart
rng.Text = "Page . "
rng.SetRange rng.End - 2, rng.End - 2
rng.Fields.Add rng, WdFieldType.wdFieldEmpty, "PAGEREF " & bookmarkText & en.Index & " \h", False
'if necessary...
'rng.Fields.Update
en.Range.Font.Hidden = False
Next
Set rng = Nothing
End Sub
For a second run, you'd need to remove and re-insert the text and fields you had added.
Unfortunately, a further look suggests that it would be difficult, if not impossible, to hide the endnote references (in the endnotes themselves) without hiding the paragraph marker at the end of the first endnote para, which means that all the endnotes will end up looking like a single messy note. So I deleted this Answer.
However, the OP thought the approach could be modified in a useful way so I have undeleted. I can't re-research it right away but some possibilities might be to replace every endnote mark by a bullet (as suggested by the OP) or perhaps even something as simple as a space or a "-".
For example, something like this (which also hides the references using a different technique)...
Sub modifyEndNotes2()
' this version also formats the endnotes under page headings
Const bookmarkText As String = "endnote"
Dim en As Word.Endnote
Dim f As Word.Field
Dim i As Integer
Dim rng As Word.Range
Dim strSavedPage As String
strSavedPage = ""
For Each en In ActiveDocument.Endnotes
en.Reference.Bookmarks.Add bookmarkText & en.Index
Set rng = en.Range
rng.Collapse WdCollapseDirection.wdCollapseStart
If CStr(en.Reference.Information(wdActiveEndPageNumber)) <> strSavedPage Then
strSavedPage = CStr(en.Reference.Information(wdActiveEndPageNumber))
rng.Text = "Page :-" & vbCr & " - "
rng.SetRange rng.End - 6, rng.End - 6
rng.Fields.Add rng, WdFieldType.wdFieldEmpty, "PAGEREF " & bookmarkText & en.Index & " \h", False
rng.Collapse WdCollapseDirection.wdCollapseEnd
Else
rng.Text = "- "
End If
Next
If ActiveDocument.Endnotes.Count > 1 Then
ActiveDocument.Styles(wdStyleEndnoteReference).Font.Hidden = True
Else
ActiveDocument.Styles(wdStyleEndnoteReference).Font.Hidden = False
End If
Set rng = Nothing
End Sub
In the above case, notice that there is only one link to each page, that formatting might be needed to make it obvious that it is a link, and so on.
I have multiple large docx files (word 2010) which need to be split on basis of a delimiter ("///"). I tried using a macro given http://www.vbaexpress.com/forum/showthread.php?39733-Word-File-splitting-Macro-question
However it gives an error "This method or Property is not available since No Text is Selected" on the line colNotes(i).Copy (Sub SplitNotes(...)).
The macro is reproduced below:
Sub testFileSplit()
Call SplitNotes("///", "C:\Users\myPath\temp_DEL_008_000.docx")
End Sub
Sub SplitNotes(strDelim As String, strFilename As String)
Dim docNew As Document
Dim i As Long
Dim colNotes As Collection
Dim temp As Range
'get the collection of ranges
Set colNotes = fGetCollectionOfRanges(ActiveDocument, strDelim)
'see if the user wants to proceed
If MsgBox("This will split the document into " & _
colNotes.Count & _
" sections. Do you wish to proceed?", vbYesNo) = vbNo Then
Exit Sub
End If
'go through the collection of ranges
For i = 1 To colNotes.Count
'create a new document
Set docNew = Documents.Add
'copy our range
colNotes(i).Copy
'paste it in
docNew.Content.Paste
'save it
docNew.SaveAs fileName:=ThisDocument.path & "\" & strFilename & Format(i, "000"), FileFormat:=wdFormatDocument
docNew.Close
Next
End Sub
Function fGetCollectionOfRanges(oDoc As Document, strDelim As String) As Collection
Dim colReturn As Collection
Dim rngSearch As Range
Dim rngFound As Range
'initialize a new collection
Set colReturn = New Collection
'initialize our starting ranges
Set rngSearch = oDoc.Content
Set rngFound = rngSearch.Duplicate
'start our loop
Do
'search through
With rngSearch.Find
.Text = strDelim
.Execute
'if we found it... prepare to add to our collection
If .Found Then
'redefine our rngfound
rngFound.End = rngSearch.Start
'add it to our collection
colReturn.Add rngFound.Duplicate
'reset our search and found for the next
rngSearch.Collapse wdCollapseEnd
rngFound.Start = rngSearch.Start
rngSearch.End = oDoc.Content.End
Else
'if we didn't find, exit our loop
Exit Do
End If
End With
'shouldn't ever hit this... unless the delimter passed in is a VBCR
Loop Until rngSearch.Start >= ActiveDocument.Content.End
'and return our collection
Set fGetCollectionOfRanges = colReturn
End Function
For those who might be interested:
The code does work in 2010. The issue was a delimiter which was the first thing on the file...
Deleted it and it worked...
I have a Word file that contains multiple people and their details.
I need to split this file into single files for each person.
This is the code, most of it is from examples I found.
I need to split the file by the delimiter (Personal).
Each file needs to be named by their ID number situated just below the delimiter.
Sub SplitNotes (delim As String)
Dim sText As String
Dim sValues(10) As String
Dim doc As Document
Dim arrNotes
Dim strFilename As String
Dim Test As String
Dim I As Long
Dim X As Long
Dim Response As Integer
arrNotes = Split(ActiveDocument.Range, delim)
Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4)
If Response = 7 Then Exit Sub
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
'Find "EID: "
doc.Range.Find.Text = "EID: "
'Select whole line
Selection.Expand wdLine
'Assign text to variable
sText = Selection.Text
'Remove spaces
sText = Replace(sText, " ", "")
'Split string into values
sValues = Split(sText, ":")
strFilename = "Testing"
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "Agent")
doc.Close True
End If
Next I
End Sub
Sub Test()
'delimiter
SplitNotes "Name:"
End Sub
The Word document is set out as follows:
Personal
Name: John Smith
EID: Alph4num3r1c (Not a set length as i know of)
Details follow on from here
My problem is getting the ID number and using it in the save as function.
I don't have a complete understanding of how the split function works.
Split function splits a string into array of strings based on a delimeter.
For eg:
Dim csvNames, arrNames
csvNames = "Tom,Dick,Harry"
arrNames = split(csvNames,",")
Now arrNames is an array containing 3 elements. You can loop through the elements like this:
Dim i
For i = 0 to UBound(arrNames)
response.write arrNames(i) & "<br />"
Next
Now applying split function to solve your problem.
Read the line you are interested in into a variable. Lets say we have,
Dim lineWithID, arrKeyValuePair
lineWithID = "EID: Alph4num3r1c"
Split it into an array using colon
arrKeyValuePair = Split(lineWithID,":")
Now, arrKeyValuePair(1) will contain your EID
If your question is still valid I have some solution regarding file name you search.
I didn't check all part of your code (so I did but I don't have your original document to make full analysis). Back to file name- you could use below simple logic to extract name from newly created doc:
'...beginning of your code here
'next part unchanged >>
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
'<<until this moment
'remove or comment your code here!!
'and add new part of the code to search for the name
Selection.Find.Execute "EID:"
Selection.MoveRight wdWord, 1
Selection.Expand wdWord
strFilename = Trim(Selection.Text)
'and back to your code- unchanged
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "Agent")
doc.Close True
End If
Next I
'...end of sub and other ending stuff
I check it and works quite ok for me.
I'm trying to write a Word macro which inserts data from the Current User in Registry into predefined bookmarks in the document. I've got an ini-file which dictates what the names of each registry entry is, and that value is then imported into a loop in the Word Macro. This works fine (I think), but the Word macro needs to insert the data into the document as well. And this works fine if the bookmarks are there, but if they aren't, the macro seems to insert data anyway. I don't want that. I just want the macro to insert the data IF there's a bookmark coresponding to the name. I've made it so that each bookmark needs to be called ""Bookmark" & sBookMarkname".
And here's the code..
Sub MalData()
''
''// MalData Macro
''
Dim objShell
Dim strShell
Dim strDataArea
Dim Verdier() As String
Dim regPath
Dim regString
Dim Felter
Dim WScript
Dim sFileName As String
Dim iFileNum As Integer
Dim sBuf As String
sFileName = "C:\felter.ini"
If Len(Dir$(sFileName)) = 0 Then
MsgBox ("Can't find " & sFileName)
End If
''//Load values from ini-file which is later used to query the registry
Set objShell = CreateObject("Wscript.Shell")
With New Scripting.FileSystemObject
With .OpenTextFile(sFileName, ForReading)
If Not .AtEndOfStream Then regPath = .ReadLine
If Not .AtEndOfStream Then regString = .ReadLine
Do Until .AtEndOfStream
Felter = .ReadLine
On Error Resume Next
Dim sBookMarkName, sVerdi
sBookMarkNametemp = "Bookmark" & Felter
MsgBox (sBookMarkNametemp)
sVerdi = objShell.RegRead(regPath & "\" & Felter) ''"
sBookMarkName = ""
sBookMarkName = (sBookMarkNametemp)
If sVerdi <> Felter Then
Selection.GoTo What:=wdGoToBookmark, Name:=sBookMarkName
Selection.Delete Unit:=wdCharacter, Count:=0
Selection.InsertAfter sVerdi
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=sBookMarkName
End If
Loop
On Error GoTo 0
End With
End With
End Sub
Now, the error happens at about here:
sVerdi = objShell.RegRead(regPath & "\" & Felter) ''"
sBookMarkName = ""
sBookMarkName = (sBookMarkNametemp)
If sVerdi <> Felter Then
Even if the registry only contains three keys, the macro goes through every name gotten from the text file and inserts the last registry key multiple times.
Why don't you check if the bookmark exists before inserting the name?
If ActiveDocument.Bookmarks.Exists(sBookmarkName) Then
... insert using your code
End If