Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 11-26-2014, 04:00 PM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default 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.
Reply With Quote
  #2  
Old 11-26-2014, 09:16 PM
macropod's Avatar
macropod macropod is offline macro to automatically change things Windows 7 64bit macro to automatically change things Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #3  
Old 11-28-2014, 05:33 AM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default Macro

I send a original document with two verses and the result how we want it to be
Attached Files
File Type: docx result.docx (13.8 KB, 13 views)
File Type: docx test for macro original.docx (13.8 KB, 11 views)
Reply With Quote
  #4  
Old 11-28-2014, 05:24 PM
macropod's Avatar
macropod macropod is offline macro to automatically change things Windows 7 64bit macro to automatically change things Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
PS: Depending on your regional settings, you may need to change:
.Text = "[^13]{2,}"
to:
.Text = "[^13]{2;}"
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 11-28-2014, 08:01 PM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default

First I want to thank you, but I got a faillure message, so I sent you two bigger documents
Attached Files
File Type: docx original document.docx (439.0 KB, 14 views)
File Type: docx result.docx (13.8 KB, 11 views)
File Type: docx 19 HAGGAI USB.docx (141.6 KB, 11 views)
Reply With Quote
  #6  
Old 11-28-2014, 11:49 PM
macropod's Avatar
macropod macropod is offline macro to automatically change things Windows 7 64bit macro to automatically change things Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
Note that the macro now also gives a progress report on the status bar.

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]
Reply With Quote
  #7  
Old 11-30-2014, 08:16 AM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default

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?
Attached Files
File Type: docx testversie macro.docx (50.7 KB, 14 views)
Reply With Quote
  #8  
Old 11-30-2014, 01:33 PM
macropod's Avatar
macropod macropod is offline macro to automatically change things Windows 7 64bit macro to automatically change things Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #9  
Old 11-30-2014, 02:00 PM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default

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
Reply With Quote
  #10  
Old 11-30-2014, 02:35 PM
macropod's Avatar
macropod macropod is offline macro to automatically change things Windows 7 64bit macro to automatically change things Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #11  
Old 12-01-2014, 09:09 AM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default

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:
Attached Files
File Type: docx 03 JOZUA USB.docx (402.5 KB, 11 views)
Reply With Quote
  #12  
Old 12-01-2014, 08:25 PM
macropod's Avatar
macropod macropod is offline macro to automatically change things Windows 7 64bit macro to automatically change things Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #13  
Old 12-02-2014, 02:38 AM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default

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
Reply With Quote
  #14  
Old 12-02-2014, 03:30 AM
macropod's Avatar
macropod macropod is offline macro to automatically change things Windows 7 64bit macro to automatically change things Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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.
The content number (3) is correct.

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]
Reply With Quote
  #15  
Old 12-02-2014, 04:14 AM
hoekman hoekman is offline macro to automatically change things Windows 8 macro to automatically change things Office 2013
hoekman
macro to automatically change things
 
Join Date: Nov 2014
Posts: 21
hoekman is on a distinguished road
Default

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
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
macro to automatically change things 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

Other Forums: Access Forums

All times are GMT -7. The time now is 01:36 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft