#31
|
||||
|
||||
Those are not minor changes! You have deleted all the content number and title number codes and replaced them with only content and title. Plus you've added content to the start of the document, including the book name, after previously saying you wanted the book name deleted.
Try: Code:
Sub ReformatDocument() Application.ScreenUpdating = False Dim i As Long, j As Long, k As Long, l As Long, Str As String Dim RngDoc As Range, RngTmp As Range, RngVrs As Range, RngCmt As Range Dim bQuot As Boolean, SBar As Boolean, oPara As Paragraph bQuot = Options.AutoFormatAsYouTypeReplaceQuotes Options.AutoFormatAsYouTypeReplaceQuotes = False SBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Set RngDoc = ActiveDocument.Range With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Wrap = wdFindContinue .Format = True .Font.Italic = True .MatchWildcards = True .Text = "^13([!0-9]*^13)" .Replacement.Text = " ^l\1" .Execute Replace:=wdReplaceAll .Format = False .Text = "[ ]@^13" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[ ]{2;}" .Replacement.Text = " " .Execute Replace:=wdReplaceAll .Text = "\[[0-9]@\]" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With Do While .Find.Found With .Duplicate If .Words.First.Previous.Font.Italic = True Then .Paragraphs.First.Range.Font.Italic = True End If End With .Collapse wdCollapseEnd .Find.Execute Loop End With DoEvents With RngDoc Str = .Paragraphs.First.Range.Text With .Find .ClearFormatting .Replacement.ClearFormatting .Wrap = wdFindContinue .Format = False .MatchWildcards = False .Text = Str .Replacement.Text = "" .Execute Replace:=wdReplaceAll End With .InsertBefore "<book>" & vbCr & "<book_content>" & vbCr & Str & vbCr & "</book_content>" & vbCr & "<hoofdstuks>" & vbCr For Each oPara In .Paragraphs With oPara.Range If InStr(.Text, "HOOFDSTUK.") > 0 Then l = l + 1 If .Words.First.Font.Italic = True Then If IsNumeric(.Words.First) Then Set RngVrs = oPara.Range j = RngVrs.Words.First StatusBar = "Sorting Verse & Comments for " & l & ":" & j Set RngCmt = Nothing Set RngTmp = oPara.Range With RngTmp .Collapse wdCollapseEnd .End = RngDoc.End End With i = i + 1 If i Mod 100 = 0 Then DoEvents For k = 1 To RngTmp.Paragraphs.Count i = i + 1 If i Mod 100 = 0 Then DoEvents With RngTmp.Paragraphs(k).Range If .Words.First.Font.ColorIndex = wdRed Then If IsNumeric(.Words.First) Then If .Words.First = j Then Set RngCmt = .Paragraphs(1).Range With RngCmt Do While Not IsNumeric(.Paragraphs.Last.Next.Range.Characters.First) .MoveEnd wdParagraph, 1 If .End = RngDoc.End Then Exit Do If .Paragraphs.Last.Next.Range.Text = UCase(.Paragraphs.Last.Next.Range.Text) Then Exit Do Loop End With End If Exit For End If End If End With Next If Not RngCmt Is Nothing Then RngVrs.Collapse wdCollapseEnd RngVrs.FormattedText = RngCmt.FormattedText i = i + 1 If i Mod 100 = 0 Then DoEvents With RngCmt If .End = RngDoc.End Then .End = .End - 1 .Delete End With RngVrs.InsertAfter "</content>" & vbCr End If RngVrs.InsertAfter "</vers>" & vbCr End If End If End With Next DoEvents Str = "Adding tags. Please Wait •" StatusBar = Str With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindContinue .Format = False .MatchWildcards = True .Text = " ^l" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[^13]{2;}" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[A-Z. ]@([0-9]@)^13" .Replacement.Text = "<hoofdstuk number=""\1"">^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Text = "([0-9]@)[!0-9A-Z]@[A-Z]@.^13" .Replacement.Text = "<hoofdstuk number=""\1"">^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Format = True .Font.Italic = True .Text = "([0-9]@). (*)^13" .Replacement.Text = "<vers number=""\1"">^p<title>\2</title>^p" .Execute Replace:=wdReplaceAll .Text = "([0-9]@).(*)^13" .Replacement.Text = "<vers number=""\1"">^p<title>\2</title>^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Format = False .Text = "^13([0-9]@)(.*)^13" .Replacement.Text = "^p<content>\1\2^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Text = "^13\<hoofdstuk number" .Replacement.Text = "^p</hoofdstuk>^&" .Execute Replace:=wdReplaceAll .Text = "(^13\<hoofdstuks\>)^13\</hoofdstuk\>" .Replacement.Text = "\1" .Execute Replace:=wdReplaceAll Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll End With DoEvents Str = Str & " •" StatusBar = Str .Collapse wdCollapseEnd With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = False .Text = "\</vers\>" .Replacement.Text = "" .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With .End = ActiveDocument.Range.End .Text = "</vers>" & vbCr & "</hoofdstuk>" & vbCr & "</hoofdstuks>" & vbCr & "</book>" End With With ActiveDocument With .Styles(wdStyleNormal) With .ParagraphFormat .SpaceBefore = 0 .SpaceAfter = 0 .Space1 End With .Font.Name = "Courier New" End With With .Range .Style = wdStyleNormal .Font.Reset .ParagraphFormat.Reset End With End With Options.AutoFormatAsYouTypeReplaceQuotes = bQuot StatusBar = "" MsgBox "Done!" Application.ScreenUpdating = True End Sub Quote:
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#32
|
|||
|
|||
The yellow is the failure message
Sub ReformatDocument() Application.ScreenUpdating = False Dim i As Long, j As Long, k As Long, l As Long, Str As String Dim RngDoc As Range, RngTmp As Range, RngVrs As Range, RngCmt As Range Dim bQuot As Boolean, SBar As Boolean, oPara As Paragraph bQuot = Options.AutoFormatAsYouTypeReplaceQuotes Options.AutoFormatAsYouTypeReplaceQuotes = False SBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Set RngDoc = ActiveDocument.Range With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Wrap = wdFindContinue .Format = True .Font.Italic = True .MatchWildcards = True .Text = "^13([!0-9]*^13)" .Replacement.Text = " ^l\1" .Execute Replace:=wdReplaceAll .Format = False .Text = "[ ]@^13" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[ ]{2;}" .Replacement.Text = " " .Execute Replace:=wdReplaceAll .Text = "\[[0-9]@\]" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute I attached the document |
#33
|
||||
|
||||
I don't get an error with that line; indeed it is unchanged from the previous version and the same line is used multiple times. I suggest you re-copy the code from my last post and use that.
As for your attachment, I see that it has 13 pages of commentary before the first chapter. Some of that content is in green italics and other content is in normal text. I really have no idea how you want all of that material formatted, because you haven't said anything that might be relevant other than what was in your last post. Moreover, the code I have written so far relies on the first paragraph containing only the name of the book - because that is how all of your previous attachments have depicted them. Your latest attachment isn't like that and I'm not sure how I could recode the macro reliably to find whatever a given book's name might be if it's not always going to be the first paragraph.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#34
|
|||
|
|||
What comes before HOOFDSTUK. 1 is not relevant It is that they changed the structure in
<vers number="1"> <title> Toen zij nu een einde gemaakt hadden met het verdelen van het land, om zijn gebieden in bezit te nemen, gaven de kinderen Israëls een erfdeel aan Jozua, de zoon van Nun, in het midden van hen. </title> <content>49. Toen ze nu een eind gemaakt hadden. Tenslotte wordt hier iets meegedeeld over de dankbaarheid van het volk jegens Jozua. Omdat hij uit eigen beweging zijn plicht vervuld had, mocht hij een bewijs van Gods genade niet van de hand wijzen, wilde hij door smadelijke verachting Diens eer niet teniet doen. Want het voorrecht dat hem geschonken werd, was niets anders dan een eenvoudig getuigenis van de hemelse kracht die door zijn hand geopenbaard was. Geen enkele vorm van eerzucht kan hier aangewezen worden, Want hij vraagt niets voor zichzelf en komt niet zomaar met zijn begeerte op de proppen; nee, de eer die God hem al verleend had, vroeg om bevestiging door de instemming van het volk. Als dat in de doofpot gestopt was, dan was het eerder een bewijs van zorgeloosheid geweest dan van bescheidenheid. Als aan het eind van het hoofdstuk herhaald wordt dat Jozua en Eleazar een eind maakten aan de verdeling van het land, dan doelt dat op het eeuwig recht op de vastgestelde grenzen, zodat de kinderen Israëls niets zouden gaan ondernemen om een onschendbaar besluit aan het wankelen te brengen. [392] </content> </vers> AND AT THE END OF EVERY CHAPTER THE CODE </hoofdstuk> <hoofdstuk number="2"> <vers number="1"> <title>In den beginne schiep God hemel en aarde.</title> <content>1. In etc |
#35
|
||||
|
||||
It might not be relevant to you, but it is very relevant to the macro. Please re-read what I said about that.
As for: Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#36
|
|||
|
|||
Can you help me? I changed HOOFDSTUK in JESAJA, but most of the time it starts with content instead of vers I attached the document
And beneath is the macro Sub ReformatDocument1() Application.ScreenUpdating = False Dim i As Long, j As Long, k As Long, l As Long, Str As String Dim RngDoc As Range, RngTmp As Range, RngVrs As Range, RngCmt As Range Dim bQuot As Boolean, SBar As Boolean, oPara As Paragraph bQuot = Options.AutoFormatAsYouTypeReplaceQuotes Options.AutoFormatAsYouTypeReplaceQuotes = False SBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Set RngDoc = ActiveDocument.Range With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Wrap = wdFindContinue .Format = True .Font.Italic = True .MatchWildcards = True .Text = "^13([!0-9]*^13)" .Replacement.Text = " ^l\1" .Execute Replace:=wdReplaceAll .Format = False .Text = "[ ]@^13" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[ ]{2;}" .Replacement.Text = " " .Execute Replace:=wdReplaceAll .Text = "\[[0-9]@\]" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With Do While .Find.Found With .Duplicate If .Words.First.Previous.Font.Italic = True Then .Paragraphs.First.Range.Font.Italic = True End If End With .Collapse wdCollapseEnd .Find.Execute Loop End With DoEvents With RngDoc Str = .Paragraphs.First.Range.Text With .Find .ClearFormatting .Replacement.ClearFormatting .Wrap = wdFindContinue .Format = False .MatchWildcards = False .Text = Str .Replacement.Text = "" .Execute Replace:=wdReplaceAll End With .InsertBefore "<book>" & vbCr & "<book_content>" & vbCr & Str & vbCr & "</book_content>" & vbCr & "<hoofdstuks>" & vbCr For Each oPara In .Paragraphs With oPara.Range If InStr(.Text, "JESAJA.") > 0 Then l = l + 1 If .Words.First.Font.Italic = True Then If IsNumeric(.Words.First) Then Set RngVrs = oPara.Range j = RngVrs.Words.First StatusBar = "Sorting Verse & Comments for " & l & ":" & j Set RngCmt = Nothing Set RngTmp = oPara.Range With RngTmp .Collapse wdCollapseEnd .End = RngDoc.End End With i = i + 1 If i Mod 100 = 0 Then DoEvents For k = 1 To RngTmp.Paragraphs.Count i = i + 1 If i Mod 100 = 0 Then DoEvents With RngTmp.Paragraphs(k).Range If .Words.First.Font.ColorIndex = wdRed Then If IsNumeric(.Words.First) Then If .Words.First = j Then Set RngCmt = .Paragraphs(1).Range With RngCmt Do While Not IsNumeric(.Paragraphs.Last.Next.Range.Characters.F irst) .MoveEnd wdParagraph, 1 If .End = RngDoc.End Then Exit Do If .Paragraphs.Last.Next.Range.Text = UCase(.Paragraphs.Last.Next.Range.Text) Then Exit Do Loop End With End If Exit For End If End If End With Next If Not RngCmt Is Nothing Then RngVrs.Collapse wdCollapseEnd RngVrs.FormattedText = RngCmt.FormattedText i = i + 1 If i Mod 100 = 0 Then DoEvents With RngCmt If .End = RngDoc.End Then .End = .End - 1 .Delete End With RngVrs.InsertAfter "</content>" & vbCr End If RngVrs.InsertAfter "</vers>" & vbCr End If End If End With Next DoEvents Str = "Adding tags. Please Wait •" StatusBar = Str With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindContinue .Format = False .MatchWildcards = True .Text = " ^l" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[^13]{2;}" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[A-Z. ]@([0-9]@)^13" .Replacement.Text = "<hoofdstuk number=""\1"">^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Text = "([0-9]@)[!0-9A-Z]@[A-Z]@.^13" .Replacement.Text = "<hoofdstuk number=""\1"">^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Format = True .Font.Italic = True .Text = "([0-9]@). (*)^13" .Replacement.Text = "<vers number=""\1"">^p<title>\2</title>^p" .Execute Replace:=wdReplaceAll .Text = "([0-9]@).(*)^13" .Replacement.Text = "<vers number=""\1"">^p<title>\2</title>^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Format = False .Text = "^13([0-9]@)(.*)^13" .Replacement.Text = "^p<content>\1\2^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Text = "^13\<hoofdstuk number" .Replacement.Text = "^p</hoofdstuk>^&" .Execute Replace:=wdReplaceAll .Text = "(^13\<hoofdstuks\>)^13\</hoofdstuk\>" .Replacement.Text = "\1" .Execute Replace:=wdReplaceAll Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll End With DoEvents Str = Str & " •" StatusBar = Str .Collapse wdCollapseEnd With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = False .Text = "\</vers\>" .Replacement.Text = "" .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With .End = ActiveDocument.Range.End .Text = "</vers>" & vbCr & "</hoofdstuk>" & vbCr & "</hoofdstuks>" & vbCr & "</book>" End With With ActiveDocument With .Styles(wdStyleNormal) With .ParagraphFormat .SpaceBefore = 0 .SpaceAfter = 0 .Space1 End With .Font.Name = "Courier New" End With With .Range .Style = wdStyleNormal .Font.Reset .ParagraphFormat.Reset End With End With Options.AutoFormatAsYouTypeReplaceQuotes = bQuot StatusBar = "" MsgBox "Done!" Application.ScreenUpdating = True End Sub |
#37
|
||||
|
||||
The string 'hoofdstuk' appears in the code 10 times - you've only changed one instance.
Personally, I'd be inclined to leave the code alone in that regard and merely add another line at the end to change all occurrences of 'hoofdstuk' in the document to 'jesaja'.For that, you could add: Code:
With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Text = "([\</])hoofdstuk" .Replacement.Text = "\1jesaja" .Wrap = wdFindContinue .Format = False .MatchWildcards = True .Execute Replace:=wdReplaceAll End With .Style = wdStyleNormal PS: When posting code, please use the code tags, indicated by the # symbol on the posting menu, to enclose your formatted code.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#38
|
|||
|
|||
Thanks, but the other problem with the document that I attached is, that many times the macro doesn't make <vers number> and <title> but begins with <content>
|
#39
|
||||
|
||||
Once again, the format of the document you have posted is different from what the macro is designed to work with. Evidently it is a portion of Isaiah. The macro requires chapters to begin with strings like:
HOOFDSTUK. 1 2e HOOFDSTUK. 3e HOOFDSTUK. ... 24de HOOFDSTUK. but what your latest attachment has is: JESAJA 43 JESAJA 44 ... JESAJA 49 You can change these to the correct format with a wildcard Find/Replace, where: Find = JESAJA ([0-9]@)^13 Replace = \1 HOOFDSTUK.^13 Note, though, that the first chapter must begin with HOOFDSTUK. 1
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#40
|
|||
|
|||
It starts with <content> instead of <title>....</title> etc
I sent a small document I started with the macro. You see the document and the macro result attached Can you see what goes wrong? |
#41
|
||||
|
||||
Yet again your test document is formatted differently from the others for which I developed the code!!! It's even different from the 'jesaja' document in post #44. Your very first chapter entry, for example (i.e. 1e HOOFDSTUK.) has two faults:
1. it is in italics; and 2. it should read 'HOOFDSTUK. 1', not '1e HOOFDSTUK.' The macro relies on the verses alone being in italics and the first chapter being indicated by 'HOOFDSTUK. 1'. I cannot keep re-writing the macro for every different document format you have. You are going to have to ensure that every document is correctly formatted before running the macro. Getting the documents all into a consistent format will be good for whatever else you use them for also.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
VBA Dropdown change list Entries automatically | QA_Compliance_Advisor | Word VBA | 20 | 09-16-2014 07:29 AM |
AutoFill- Auto Change Certain things in document? | DaveWW00 | Word | 1 | 08-06-2013 11:33 AM |
How to change dates automatically | PaperBuster | Word | 5 | 09-24-2012 09:31 PM |
Automatically change the value of one cell so that two other cells become equal | matthew544 | Excel | 5 | 09-18-2011 08:56 AM |
How can I change the colors of cells automatically based on Job Completion? | Learner7 | Excel | 0 | 07-06-2010 10:47 PM |