#16
|
|||
|
|||
This one gives me Line Break *** Paragraph break, and also does it in one go for all paragraphs, whatever the length, but isn't what I need.
I need asterisks at the beginning of the next paragraph, following the paragraph break hit at the end of the previous one, like this: "Some say he came up with the Boleyns, the queen’s family. PB ***Some say it is whole through the late Cardinal Wolsey... In other words, the previous paragraph needs to end with a paragraph break and the next one to begin with ***. The first tweak to the script does this except for the hitch with longer paragraphs, and the second one would be perfect except for the additional paragraph break following the asterisks. I use this autohotkey script to move to the space between paragraphs and start typing in red color: #IfWinActive ahk_class OpusApp ^2:: Send ^{Down} Send ^{Down} Send ^{Left} Send {Enter} { oWord := ComObjActive("Word.Application") ; MS Word object wdColorDarkRed = 128 oWord.Selection.Font.Color := wdColorDarkRed } return When I finish the translation I simply replace all instances of ^p*** with a space, remove all the original text which is in black color and get the translated parts glued into the originally sized paragraph. Probably not the most elegant way of doing this but does the job for me. |
#17
|
||||
|
||||
In that case, go back to using:
.InsertAfter vbCr & "*** " & vbCr and after: .Start = .Paragraphs.Last.Next.Range.Start insert: .Paragraphs.First.Range.Characters.First.Previous. Delete
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#18
|
|||
|
|||
And this one works like a charm if there is no other paragraph breaks in the document, only solid chunk of text. But any document has some paragraph structure and running the macro now deletes all the existing paragraph breaks in the document and restructures the whole document into the paragraph sizes set by the code
|
#19
|
||||
|
||||
Ah, the joys of trying to adapt code written for one thing to do something else! Try:
Code:
Sub TextSplitter() Dim Rng As Range Application.ScreenUpdating = False With ActiveDocument Set Rng = .Range(0, 0) Do With Rng On Error GoTo ErrExit .MoveEndUntil cset:=vbCr, Count:=wdForward If Len(.Text) > 500 Then .End = .Start + 500 .End = .Start + InStrRev(Rng.Text, ".") + 1 If .Characters.Last.Text <> vbCr Then .Characters.Last.Delete .InsertAfter vbCr & "*** " & vbCr End If End If DoEvents .Start = .Paragraphs.Last.Next.Range.Start End With Loop Until Rng Is Nothing ErrExit: With .Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = "*** " & vbCr .Replacement.Text = "*** " .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With End With Set Rng = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#20
|
|||
|
|||
Sorry for the bother Paul. The same thing with this code, .InsertAfter vbCr & "*** " & vbCr tweak works just fine, but it adds space and an extra paragraph break after the asterisks, and that makes it unusable to my specific purposes, though as you said it will sure be perfect to its original general purpose. I could replace every instance of *** ^p with *** and it would be perfect, but there is enough extra work as it is with editing documents and I'm trying to save me some time.
|
#21
|
||||
|
||||
It works for me. Each paragraph ends up with:
*** Suspendisse dui purus, etc.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#22
|
|||
|
|||
I made a mistake I apologize, it works perfectly! Aaahh, greattt, thank you a million Paul!
|
#23
|
|||
|
|||
Your routine is fabulous...except
Hi,
I ran your routine on my document and it put in a paragraph mark to break up large paragraphs into (<=300 characters in my version). It looks backward for the sentence mark. It mostly works except that once in a while it puts a bundle of empty paragraphs in the document for a couple of pages. I'm wondering if ypu know why. I'm trying to debug it now. Thanks. P.S. I noticed you did this a while ago so I hope you respond and I can send you the document. |
#24
|
|||
|
|||
Lots of empty paragraphs
Also I ran your pure program (the first one) with 500 characters as the criteria and that inserts a huge number of empty paragraphs (vbCR)
|
#25
|
||||
|
||||
Try this alternative approach to see if you are still getting the same issue.
Code:
Sub TextSplitter2() Dim Rng As Range, iStep As Long, iStart As Long, iEnd As Long Application.ScreenUpdating = False With ActiveDocument iStep = 500 iStart = 0 Do While iStart < .Range.End - iStep If iStart + iStep > .Range.End Then iEnd = .Range.End Else iEnd = iStart + iStep End If Set Rng = .Range(iStart, iStart + iStep) If Rng.Characters.Last.Text = vbCr Then iStart = iStart + iStep Else Set Rng = .Range(Rng.Sentences.Last.Start, Rng.Sentences.Last.Start) Rng.InsertAfter vbCr & "*** " iStart = Rng.End End If Loop End With Set Rng = Nothing Application.ScreenUpdating = True End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#26
|
|||
|
|||
Separate paragraphs into short chunks to make it readable on a cell phonoe
Thanks for trying but the code just takes forever to run. It is proceeding a character at a time until it reaches 500 characters. I have written another version that breaks up the paragraphs into 300 characters or more unless the remaining characters in the paragraph are less than 400 ( so you don't end a paragraph with a small sentence) at the end. It uses the 2 for each clauses. Here is the code. It does a fair job but I think that my tc(total characters) ts(total sentences) are not properly aligned with the actual sentences and characters. This leaves a small sentence internally (bug: probably relates to inserting a vbcr that still has more characters/sentences to include in the paragraph. This relates to the fact that the sentence and character count changes when you insert a paragraph mark in the middle of the paragraph, so occasionally I get a short sentence within the group of paragraphs.
It has the virtue of not crashing and running quickly. See if you can improve on it. Also, I don't want it to insert a blank paragraph at the very end. Sub insertp() Dim p As Paragraph Dim ts As Long Dim tc As Long Dim i As Long Dim doc As Document Set doc = ActiveDocument Application.ScreenUpdating = Falsec For Each p In doc.Paragraphs ts = 0 tc = 0 For Each sn In p.Range.Sentences ts = ts + 1 tc = tc + Len(sn) If p.Range.Characters.Count < 400 Then Exit For End If If tc >= 300 And ts < p.Range.Sentences.Count Then p.Range.Sentences(ts).InsertAfter vbCr tc = 0 ts = 0 End If Next Next Application.ScreenUpdating = True End Sub thanks for any help. Last edited by John O'Rourke; 11-13-2021 at 12:40 PM. |
#27
|
|||
|
|||
Latest and Greatest
I decided that there is a problem in the VBA word handling of for each p in doc.paragraphs and the for each sn in p.range.sentences. When you insert vbcr the number of paragraphs increases and the number of total sentences decreases. It thinks you are in the next paragraph sort of but its first sentence is the last sentence of the prior paragraph. I decided to abandon for each method and use set p=doc.paraphs(i)
and just increment i by hand and read the next paragraph as if I were processing a file. Then I can completely control the positioning, characters, sentences and go through the document quickly and accurately. I don't now get short sentences inside each paragraph but there may be a couple of short sentences as the last sentence. This may require playing with various cutoffs to get something that handles most conditions but I like what I have now. For those of you that shudder at gotos please don't look at the code. Code:
Sub insertp() Dim doc As Document Dim p As Paragraph Dim sn As Variant Dim ts As Long Dim tc As Long Dim i As Long Set doc = ActiveDocument Application.ScreenUpdating = False i = 0 GoTo NextParagraph ProcessPara: Set sn = p.Range.Sentences(ts) tc = tc + Len(sn) If tc >= 300 And ts < p.Range.Sentences.Count Then p.Range.Sentences(ts).InsertAfter vbCr GoTo NextParagraph End If ts = ts + 1 If ts < p.Range.Sentences.Count Then GoTo ProcessPara End If NextParagraph: i = i + 1 If i <= doc.Paragraphs.Count Then Set p = doc.Paragraphs(i) If p.Range.Sentences.Count > 0 And p.Range.Characters.Count > 450 Then ts = 1 tc = 0 GoTo ProcessPara Else GoTo NextParagraph End If End If Application.ScreenUpdating = True End Sub |
#28
|
|||
|
|||
Post Script
Hi, was thinking that the code that started all of this was probably written to put paragraphs in a document that had no paragraph marks in it (maybe). I think when it got to my document possibly it couldn't handle already existing paragraphs?? I don't know for sure but my final version can be run more than once on the document and doesn't put new paragraphs in on the second run because the chunks are all the proper length. Anyways I thank the original coders for their help and hope I can be of help myself on the forum.
|
#29
|
|||
|
|||
Also, I don't want to overgeneralize about this style of programming in VBA for word but perhaps the times when I have encountered bugs in Word are when using some of the more sophisticated structures. I'm going to go back and review some places where I've had a lot of trouble and simply use a simpler goto structure and set x = object and simple range.count type of loops (no for next) and see if I can get a consistent result.
|
Tags |
paragraph character |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Restricting paragraph styles without restricting character styles | Red Pill | Word | 5 | 05-25-2012 01:06 PM |
character set | bobster | Word | 0 | 06-07-2011 10:17 AM |
tab key arrows first character | carolinason | Word | 6 | 10-30-2010 06:45 PM |
Junk characters (box-like characters) in Word file | Sashikala | Word | 1 | 04-20-2010 02:03 PM |
Character style stripped while applying paragraph style | sams_gates | Word | 0 | 08-29-2009 02:03 AM |