#1
|
|||
|
|||
macro to automatically change things
THIS IS THE RESULT WE WANT FROM THE TRANSLATION <book titel="GENESIS"> <chapter number='1'> <vers number='1'>In den beginne schiep God hemel en aarde.</vers> <vers number='2'>De aarde nu was wanstaltig en ledig, en duisternis was op de oppervlakte des afgronds; en de Geest Gods zweefde op de wateren.</vers> <vers number='3'>En God zeide: Er zij licht. En er was licht.</vers> This is what we did with a lot of work with the following text so that it can be read for a ipad THIS WAS THE ORIGINAL TEXT OF THE TRANSLATION GENESIS 1ste HOOFDSTUK. 1. In den beginne schiep God hemel en aarde. 2. De aarde nu was wanstaltig en ledig, en duisternis was op de oppervlakte des afgronds; en de Geest Gods zweefde op de wateren. But we also want to do the same as we did in the top of this document with book chapter vers numer and explanation of that vers Is there a macro possible that can do that trick as we did above with the text? The text is Dutch because where from the Netherlands THIS IS THE EXPLINATION 1. In den beginne. Het woord begin op Christus te laten slaan, is al te gezocht. 2. Was wanstaltig en ledig. Met het uitleggen dezer beide woorden תֹהוּ וָבֹהוּ , zal ik mij niet druk maken. |
#2
|
||||
|
||||
That may be possible, but we'd need to see an actual document with some of the content before a solution could be developed. Can you attach a document to a post with some representative content (e.g. a couple of chapters from different books)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Macro
I send a original document with two verses and the result how we want it to be
|
#4
|
||||
|
||||
You can try the following macro. I did ask you to attach a document with "a couple of chapters from different books", but you only attached a document with a couple of verses. Because you gave me so little to work with, I have no idea how well it will work with a larger document. Do note that there is a lot of processing to be done, and the larger the document the longer it will take.
Code:
Sub ReformatDocument() Application.ScreenUpdating = False Dim i As Long, j As Long, k As Long, l As Long, x As Long Dim RngDoc As Range, RngVrs As Range, RngCmt As Range, bQuot As Boolean bQuot = Options.AutoFormatAsYouTypeReplaceQuotes Options.AutoFormatAsYouTypeReplaceQuotes = False With ActiveDocument.Styles(wdStyleNormal) With .ParagraphFormat .SpaceBefore = 0 .SpaceAfter = 0 .Space1 End With .Font.Name = "Courier New" End With Set RngDoc = ActiveDocument.Range With RngDoc x = .Paragraphs.Count For i = 1 To x With .Paragraphs(i).Range If .Font.Italic = True Then If IsNumeric(.Words.First) Then j = .Words.First Set RngVrs = .Paragraphs(1).Range Set RngCmt = Nothing For k = i + 1 To x With RngDoc.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.Words.First) .MoveEnd wdParagraph, wdForward 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 End If End If End With Next If Not RngCmt Is Nothing Then RngVrs.Collapse wdCollapseEnd RngVrs.FormattedText = RngCmt.FormattedText 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 With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindContinue .Format = False .MatchWildcards = True .Text = "[^13]{2,}" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "([A-Z0-9 ]@)^13[A-Z. ]@([0-9]@)^13" .Replacement.Text = "<boek titel=""\1"">^p <hoofdstuk number=""\2"">^p" .Execute Replace:=wdReplaceAll .Format = True .Font.Italic = True .Text = "([0-9]@).(*)^13" .Replacement.Text = " <vers number=""\1"">^p <title number=""\1"">\2^p</title>^p" .Execute Replace:=wdReplaceAll .Format = False .Text = "([0-9]@)(.*)^13" .Replacement.Text = " <content number=""\1"">\1\2^p" .Execute Replace:=wdReplaceAll End With .Style = wdStyleNormal .Font.Reset .ParagraphFormat.Reset End With Options.AutoFormatAsYouTypeReplaceQuotes = bQuot Application.ScreenUpdating = True End Sub .Text = "[^13]{2,}" to: .Text = "[^13]{2;}"
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
First I want to thank you, but I got a faillure message, so I sent you two bigger documents
|
#6
|
||||
|
||||
For your revised 'original document', try:
Code:
Sub ReformatDocument() Application.ScreenUpdating = False Dim i As Long, j As Long, k As Long, l As Long, x 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 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 For k = 1 To RngTmp.Paragraphs.Count 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 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" 'Str = Str & " •" 'StatusBar = Str .Execute Replace:=wdReplaceAll '.Text = "([A-Z0-9 ]@)^13[A-Z. ]@([0-9]@)^13" '.Replacement.Text = "<boek titel=""\1"">^p <hoofdstuk number=""\2"">^p" .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 number=""\1"">\2^p</title>^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Format = False .Text = "^13([0-9]@)(.*)^13" .Replacement.Text = "^p <content number=""#"">\1\2^p" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Text = "^13 \<hoofdstuk number" .Replacement.Text = "^p</hoofdstuks>^p</hoofdstuk>^&" Str = Str & " •" StatusBar = Str .Execute Replace:=wdReplaceAll .Wrap = wdFindStop .Text = "hoofdstuk number=""<[0-9]@>" .Replacement.Text = "" .Execute End With DoEvents Str = Str & " •" StatusBar = Str Do While .Find.Found i = Split(.Text, Chr(34))(1) .Collapse wdCollapseEnd Do While InStr(.Paragraphs.Last.Next.Range.Text, "<hoofdstuk number=") = 0 .MoveEnd wdParagraph, 1 If .End = ActiveDocument.Range.End Then Exit Do Loop With .Duplicate.Find .Wrap = wdFindStop .Text = "(content number="")#" .Replacement.Text = "\1" & i .MatchWildcards = True .Execute Replace:=wdReplaceAll End With .Collapse wdCollapseEnd .Find.Execute Loop .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 .InsertBefore "<book>" & vbCr & "<book_content>" & vbCr & "<hoofdstuks>" & vbCr .Style = wdStyleNormal .Font.Reset .ParagraphFormat.Reset End With End With Options.AutoFormatAsYouTypeReplaceQuotes = bQuot StatusBar = "" MsgBox "Done!" Application.ScreenUpdating = True End Sub In most cases, your document containes chapter numbers expressed like 'HOOFDSTUK. 1' or '2de HOOFDSTUK.', but you also have one expressed as 'HOOFDSTUK XIII.' The macro does not attempt to reformat the last kind - it would take a lot of extra programming to process chapters using Roman Numerals. You should make sure they're all expressed in one of the first two forms before running the macro. I don't know what you expect to be done with your Haggai document - it isn't formatted anything like your revised 'original document'. I don't propose to work out the programming requirements for a plethora of different formats. You should make sure all the documents are formatted the same way as your revised 'original document'.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
I still get a # instead of the chapter number
</content> </vers> <vers number="2"> <title number="2"> De aarde nu was wanstaltig en ledig, en duisternis was op de oppervlakte des afgronds; en de Geest Gods zweefde op de wateren. </title> <content number="#">2. BUT FROM CHAPTER 2 THE MACRO WORKS </content> </vers> <hoofdstuk number="2"> <vers number="1"> <title number="1"> Alzoo zijn voltooid, de hemelen en de aarde, en al hun heir. </title> <content number="2">1. ‘Zoo werden volbracht’ Kortelijks herhaalt Mozes, dat het gebouw van hemel en aarde in zes dagen voltooid is geweest. Can you try the piece of the document I attached? |
#8
|
||||
|
||||
It won't work on your latest attachment because you have changed the referencing! Your previous version had:
HOOFDSTUK. 1 Your latest version has: HOOFDSTUK 1. You cannot expect to get the same results if you go changing the data.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
I don't know how to thank you. What you did is great.
It saves us thousands of hours work. We are developping a program for the tablet and one of the main issues was the way they wanted to get the document. Thanks - Thanks |
#10
|
||||
|
||||
Do be aware that, unless you fix the roman numeral references like 'HOOFDSTUK XIII.' and change them to '13de HOOFDSTUK.', you won't get the correct results. For example, you won't get '<hoofdstuk number="13">' and you will still be getting '<content number="12">' where you should be getting '<content number="13">'.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Not all documents are the same. The structure in most documents is like the one I attached JOZUA Is it difficult to change the script so that it also works with Jozua
This is the Jozua document: |
#12
|
||||
|
||||
A reformatting macro can only work if the documents are consistent. Your Jozua and Haggai documents are not consistent with your Genesis document. There are some things you would need to change for the existing macro to work with your Jozua document:
1. You would need to delete all the content before - JOZUA HOOFDSTUK. 1 I really don't know what you intend to happen with all that content and the macro simply doesn't process it properly. 2. Within the 'HOOFDSTUK. 1' range, there are two references to 'JOZUA 1': one before verse 5 and one before verse 10. You would need to delete both of those. 3. From Chapter 6 onwards, you have JOZUA references using roman numerals (sometimes repeated) instead of a '#de HOOFDSTUK.' reference at the beginning of each chapter. You need to use the '#de HOOFDSTUK.' format throughout, as advised for the Genesis document - the macro cannot process roman numerals or chapter references beginning with the book name. Not only that, but even some of the Roman numerals used for the chapters are wrong. With Chapter 22, for example, you have 'JOZUA XII'! Once you correct the Roman numeral numbering sequence, you could run the following macro to convert them all back to Arabic numbering in the form. Duplicated Roman numbering will also be deleted. That should minimise the amount of other clean-up work you need to do before running the other macro. Code:
Dim Rm As String Sub ConvertRomanChaptersToArabic() Application.ScreenUpdating = False Dim StrFnd As String, StrConv As String, StrPrev As String With ActiveDocument.Range StrFnd = Replace(Trim(.Paragraphs(1).Range.Text), vbCr, "") With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = False .MatchWholeWord = False .MatchWildcards = True .Wrap = wdFindContinue .Text = "[ ]@^13" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "(" & StrFnd & " [IVXL]@>).^13" .Replacement.Text = "\1^p" .Execute Replace:=wdReplaceAll .Wrap = wdFindStop .Text = StrFnd & " [IVXL]@>^13" .Replacement.Text = "" .Execute End With Do While .Find.Found .End = .End - 1 StrConv = .Text StrConv = Split(StrConv, " ")(UBound(Split(StrConv, " "))) If StrConv = StrPrev Then .Paragraphs(1).Range.Delete Else StrPrev = StrConv .Text = Roman2Arabic(StrConv) & "de HOOFDSTUK." End If .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub Public Function Roman2Arabic(C As String) As Long Dim TB, Arab As Long, i As Byte, A As Long, Utb As Long If C = "" Then Roman2Arabic = 0: Exit Function ReDim TB(0): i = 1: Utb = 1: Arab = 0 Rm = UCase(Replace(C, " ", "")) While i <= Len(Rm) ReDim Preserve TB(Utb) A = NBlettre(i) TB(Utb) = A * LetterVal(Mid(Rm, i, 1)) i = i + A Utb = Utb + 1 Wend ReDim Preserve TB(Utb): i = 1 While i < UBound(TB) If TB(i) < TB(i + 1) Then Arab = Arab + TB(i + 1) - TB(i) i = i + 2 Else Arab = Arab + TB(i) i = i + 1 End If Wend Roman2Arabic = Arab End Function Function NBlettre(Deb As Byte) As Byte Dim i As Long, L As String NBlettre = 1: L = Mid(Rm, Deb, 1) For i = Deb + 1 To Len(Rm) If Mid(Rm, i, 1) = L Then NBlettre = NBlettre + 1 Else Exit Function End If Next End Function Function LetterVal(L As String) As Long Dim Roman, Arabic, i As Byte Roman = Array("I", "V", "X", "L", "C", "D", "M") Arabic = Array(1, 5, 10, 50, 100, 500, 1000) For i = 0 To 6 If L = Roman(i) Then LetterVal = Arabic(i) Exit Function End If Next End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
It works just fine, thanks There is only one thing The numbering of the chapters
</content> </vers> [235] JOZUA 3e HOOFDSTUK. <vers number="1"> <title number="1"> En Jozua maakte zich des morgens vroeg op, en ze vertrokken uit Sittim, en ze kwamen tot bij de Jordaan, hij en ai de kinderen Israëls; en zij overnachtten al daar, eer ze overtrokken. </title> <content number="1">1. THIS SHOULD BE "3">1 BECAUSE THIS IS CHAPTER 3 PS IT WORKS NOW AFTER CLEENING UP WITH THE LASTMACRO It also deletes text and puts it on another position/place AFTER <content number="1">8. Dat het boek van deze wet niet van uw mond wijke, maar overdenk het dag en nacht, opdat ge waarneemt en doet naar alles wat erin geschreven [214] staat. [215 en 216 including the text are deleted] 8. Dat het boek van deze wet niet wijke... Ook wordt hem de voortdurende overdenking van de wet geboden; want als die slechts voor korte tijd onderbroken wordt, sluipen er gemakkelijk een aantal dwalingen binnen, en het geheugen raakt als het ware verroest, zodat velen, als ze van de voortdurende bestudering van de wet af zijn, als het ware als onervaren leken aan de slag gaan. God beveelt Zijn knecht dan ook dagelijks vorderingen te maken, zodat hij zijn leven lang niet op zal houden zich met de wet bezig te houden. Daaruit valt op te maken dat zij die een hekel hebben aan deze bezigheid, door een onduldbare hoogmoed verblind zijn. Maar waarom verbiedt Hij hem de wet niet van zijn mond te laten wijken, in plaats van zijn ogen? Sommigen vatten mond hier op als een pars pro toto2 2) Deel voor het geheel (Vert.). voor gelaat, maar dat is onzin. Ik [217] = pagenumer of the original book |
#14
|
||||
|
||||
Regarding numbering of the chapters, what I get is:
Code:
</content> </vers> [235] JOZUA <hoofdstuk number="3"> <vers number="1"> <title number="1"> En Jozua maakte zich des morgens vroeg op, en ze vertrokken uit Sittim, en ze kwamen tot bij de Jordaan, hij en ai de kinderen Israëls; en zij overnachtten al daar, eer ze overtrokken. </title> <content number="3">1. Regarding <content number="1">8 the problem is the blue non-italic [214] in the verse. If you format the whole verse as italic, the problem will go away.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
THIS IS THE ORIGINAL TEXT
7. Alleen, wees sterk en heb zeer goede moed, dat ge waarneemt te doen naar de ganse wet, die Mozes, Mijn knecht, u geboden heeft; wijk daar niet van af, noch ter rechter- noch ter linkerhand, opdat ge in alle dingen verstandig (of: gezegend) handelt. 8. Dat het boek van deze wet niet van uw mond wijke, maar overdenk het dag en nacht, opdat ge waarneemt en doet naar alles wat erin geschreven [214] staat. Want dan zult ge uw wegen voorspoedig maken, en dan zult ge verstandig handelen. 9. Heb Ik het u niet bevolen om sterk te zijn en goede moed te hebben? En niet te verschrikken en u niet te ontzetten? Want IK de HEERE, uw God, ben met u, overal waar ge heengaat. 5. Niemand zal bestaan. Omdat er moeilijkheden dreigden met vele, oorlogszuchtige vijanden, was het nodig dat Jozua met bijzonder veel vertrouwen toegerust werd. Anders zou THIS IS THE OUTCOME (That deletes sentences) <vers number="8"> <title number="8"> Dat het boek van deze wet niet van uw mond wijke, maar overdenk het dag en nacht, opdat ge waarneemt en doet naar alles wat erin geschreven [214] staat. </title> <content number="1">8. Dat het boek van deze wet niet wijke... Ook wordt hem de voortdurende overdenking van de wet geboden; want als die slechts voor korte tijd onderbroken wordt, sluipen er gemakkelijk een aantal dwalingen binnen, en het geheugen raakt als het ware verroest, zodat velen, als ze van de voortdurende bestudering van de wet af zijn, als het ware als onervaren leken aan de slag gaan. God beveelt Zijn knecht dan ook dagelijks vorderingen te maken, zodat hij zijn leven lang niet op zal houden zich met de wet bezig te houden. Daaruit valt op te maken dat zij die een hekel hebben aan deze bezigheid, door een onduldbare hoogmoed verblind zijn. Maar waarom verbiedt Hij hem de wet niet van zijn mond te laten wijken, in plaats van zijn ogen? Sommigen vatten mond hier op als een pars pro toto2 2) Deel voor het geheel (Vert.). voor gelaat, maar dat is onzin. Ik [217] AND THE TEXT IS PLACED ON ANOTHER PLACE [PAGENUMBER 222] aanmoedigen. [222] </content> </vers> <content number="1">17. Zoals wij in alles naar Mozes gehoord hebben, alzo zullen we naar u horen; alleen, dat de HEERE, uw God, met u zij, zoals Hij met Mozes geweest is! 18. Alle man die uw mond weerspannig zal zijn en die geen genoegen zal nemen met uw woorden, in [219] alles wat ge hem gebieden zult, die zal gedood worden; alleen, wees sterk en heb goede moed. </vers> 2e HOOFDSTUK. <content number="1">1. [AND IT ALSO SAYS "1">1 SHOULD BE "2">1 |
Thread Tools | |
Display Modes | |
|
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 |