Retaining formatting?

[leecable]

So, after everyone's help. I have managed to sort my issue. With the help of gregs splitter, its split the document, retaining format. Which is exactly what I want.

The issue is, I want to know how todo it myself, rather than having to use gregs splitter..


Sub SplitNotes(delim As String, strFilename As String)
Dim doc As Document
Dim arrNotes
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)
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000")
doc.Close True
End If
Next I
End Sub
Sub test()
'delimiter & filename
SplitNotes "delimiter", "Notes "
End Sub

So how do I go about adding it to this? Could someone add it, so that I can see a before and after? Its the easiest way my brain works!

[gmaxey]

Yours works to create the split documents, but those documents are not formatted. The reason is you are creating an array of strings (strings have text but not formatting) from the string of document text and then adding those strings to new documents.

My Add-In, basically gets the page layout of the document then copies and pastes (retaining the formatting) of range segments. So if your code would copy the text between the start of the document and first delimiter then paste it in a new document with the same page layout then it would work like mine. I don't publish that code because it took hours to develop and I hope people will use the addin and donate for my effort.

[leecable]

Ive found the relevant code in your splitter, but for the life of me, cant make it work to retain layout within my splitter! Im presuming its todo with the function at the end? I also dont want to post it, as I also want people to use it and see how good it is! You'll sure be getting a donation from myself when payday comes around!

[gmaxey]

If the code you found doesn't work then it is possible that it isn't the relevant code. Go ahead and post it. If you found it then others could as well.

[leecable]

If the code you found doesn't work then it is possible that it isn't the relevant code. Go ahead and post it. If you found it then others could as well.


Function SaveAsType(ByRef oDoc_Passed) As Long
SaveAsType = oDoc_Passed.SaveFormat
End Function

I'm guessing its to do with this bit Greg? Is a function something I can just add to the end of a script? I presume its going to have be manipulated in a certain way?

Thanks

[gmaxey]

All that function does is return a long value e.g., 15 indicating the type of source document. For example if the source document is a MacroEnabledXMLFormatTemplate, it returns 15.

I really can't make any sense of what your issue is unless you post your entire code. Splitting the source document into a string array as you have shown is not going to work though for the reasons I've stated. I'm not going to post the complete solution in the add-in as a tutorial either. I'm sorry.

[leecable]

Ok, that's fair enough..

Now, I have done some research, and I have discovered the PasteAndFormat method using wdFormatOriginalFormatting but, obviously this wont work, because of the string reason. So, im probably going to have to rewrite the entire thing, to take advantage of the clipboard?

[gmaxey]

Yes, that is one way with something like: .PasteAndFormat (wdFormatOriginalFormatting)

[leecable]

But, like I said. That wont work with the way my splitter works. Hmm, back to the drawing board.

[leecable]

So I am going to cheat and modify my normal template, so that its exactly how I want, and run it from there. That'll do the job untill I can work out how to do it any other way.

[gmaxey]

Since you have yet to post your splitter, then I can't say if it will work or not. Study this:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 7/13/2017
Dim lngParts As Long
Dim oRng1 As Range, oRng2 As Range, oRng3 As Range
Dim lngIndex As Long
Dim strDelim As String
Dim oDoc As Document
strDelim = "///"
Set oRng1 = ActiveDocument.Range
Set oRng2 = ActiveDocument.Range
lngParts = UBound(Split(oRng1.Text, strDelim)) + 1
lngIndex = 1
While lngIndex <= lngParts
With oRng1.Find
.Text = strDelim
If .Execute Then
If lngIndex = 1 Then
Set oRng3 = oRng1
oRng3.End = oRng1.Start
oRng3.Start = ActiveDocument.Range.Start
Else
oRng2.Start = oRng1.End
With oRng2.Find
.Text = strDelim
If .Execute Then
Set oRng3 = oRng1
oRng3.Start = oRng1.End '+ 1
oRng3.End = oRng2.Start
Else
oRng3.Start = oRng1.End '+ 1
oRng3.End = ActiveDocument.Range.End
End If
End With
End If
oRng3.Copy
oRng1.Collapse wdCollapseEnd
oRng2.Collapse wdCollapseEnd
End If
End With
Set oDoc = Documents.Add(ActiveDocument.AttachedTemplate.FullName)
oDoc.Content.Delete 'Strip template boiler plate text
With Selection
.PasteAndFormat (wdFormatOriginalFormatting)
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
.Delete Unit:=wdCharacter, Count:=1
End With
oDoc.UpdateStylesOnOpen = False
'I'll leave it to you to figure out how to save it.
oDoc.Close wdDoNotSaveChanges
lngIndex = lngIndex + 1
Wend
lbl_Exit:
Exit Sub
End Sub

[leecable]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 7/13/2017
Dim lngParts As Long
Dim oRng1 As Range, oRng2 As Range, oRng3 As Range
Dim lngIndex As Long
Dim strDelim As String
Dim oDoc As Document
strDelim = "Aziylut"
Set oRng1 = ActiveDocument.Range
Set oRng2 = ActiveDocument.Range
lngParts = UBound(Split(oRng1.Text, strDelim)) + 1
lngIndex = 1
While lngIndex <= lngParts
With oRng1.Find
.Text = strDelim
If .Execute Then
If lngIndex = 1 Then
Set oRng3 = oRng1
oRng3.End = oRng1.Start
oRng3.Start = ActiveDocument.Range.Start
Else
oRng2.Start = oRng1.End
With oRng2.Find
.Text = strDelim
If .Execute Then
Set oRng3 = oRng1
oRng3.Start = oRng1.End '+ 1
oRng3.End = oRng2.Start
Else
oRng3.Start = oRng1.End '+ 1
oRng3.End = ActiveDocument.Range.End
End If
End With
End If
oRng3.Copy
oRng1.Collapse wdCollapseEnd
oRng2.Collapse wdCollapseEnd
End If
End With
Set oDoc = Documents.Add(ActiveDocument.AttachedTemplate.FullName)
oDoc.Content.Delete 'Strip template boiler plate text
With Selection
.PasteAndFormat (wdFormatOriginalFormatting)
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
.Delete Unit:=wdCharacter, Count:=1
End With
oDoc.UpdateStylesOnOpen = False
'I'll leave it to you to figure out how to save it.
X = X + 1
ActiveDocument.SaveAs2 ThisDocument.Path & "\" & Notes & Format(X, "000")
oDoc.Close wdDoNotSaveChanges
lngIndex = lngIndex + 1
Wend
End Sub




Not going to Lie Greg, I cant thank you enough. I've gone from a novice who can read no VBA, so actually understanding what is happening and why its happening...in less than 5 days. I really appreciate all of your help!

[leecable]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 7/13/2017
Dim lngParts As Long
Dim oRng1 As Range, oRng2 As Range, oRng3 As Range, oRng4 as Range
Dim lngIndex As Long
Dim strDelim As String
Dim oDoc As Document
strDelim = "Aziylut"
Set oRng1 = ActiveDocument.Range
Set oRng2 = ActiveDocument.Range
lngParts = UBound(Split(oRng1.Text, strDelim)) + 1
lngIndex = 1
While lngIndex <= lngParts
With oRng1.Find
.Text = strDelim
If .Execute Then
If lngIndex = 1 Then
Set oRng3 = oRng1
oRng3.End = oRng1.Start
oRng3.Start = ActiveDocument.Range.Start
Else
oRng2.Start = oRng1.End
With oRng2.Find
.Text = strDelim
If .Execute Then
Set oRng3 = oRng1
oRng3.Start = oRng1.End '+ 1
oRng3.End = oRng2.Start
Else
oRng3.Start = oRng1.End '+ 1
oRng3.End = ActiveDocument.Range.End
End If
End With
End If
oRng3.Copy
oRng1.Collapse wdCollapseEnd
oRng2.Collapse wdCollapseEnd
End If
End With
Set oDoc = Documents.Add(ActiveDocument.AttachedTemplate.FullName)
oDoc.Content.Delete 'Strip template boiler plate text
With Selection
.PasteAndFormat (wdFormatOriginalFormatting)
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
.Delete Unit:=wdCharacter, Count:=1
End With
oDoc.UpdateStylesOnOpen = False
Set oRng4 = oDoc.Range
With oRng4.Find
.Text = "Title"
If .Execute Then
oRng4.MoveEndUntil Chr(13)
oRng4.Start = oRng4.Start + 7
End If
End With
ActiveDocument.SaveAs2 ThisDocument.Path & "\" & oRng4.text
oDoc.Close wdDoNotSaveChanges
lngIndex = lngIndex + 1
Wend
End Sub

So much so, ive managed to merge both scripts, so now it finds the texts, copys, pastes, finds 'title' as uses it as the filename.

[gmaxey]

Now you just need to develop your SaveAs to ensure that you don't write over existing files.