-
Preserve formatting
Hello I need help.
I have two documents with text with different color and formatting.
The first document is: Book.doc
Mat 1:1 Genealogia di Gesù Cristo figlio di Davide, figlio di Abramo.
Mat 1:2 Abramo generò Isacco, Isacco generò Giacobbe, Giacobbe generò Giuda e i suoi fratelli,
Mat 1:3 Giuda generò Fares e Zara da Tamar, Fares generò Esrom, Esrom generò Aram,
Mat 1:4 Aram generò Aminadàb, Aminadàb generò Naassòn, Naassòn generò Salmon,
Mat 1:5 Salmon generò Booz da Racab, Booz generò Obed da Rut, Obed generò Iesse,
The 2nd is: Notes.doc
[Mat 1,1] Genealogia di Gesù Cristo figlio di Davide, figlio di Abramo.
[Mat 1,2] Abramo generò Isacco, Isacco generò Giacobbe, Giacobbe generò Giuda e i suoi fratelli,
[Mat 1,3] Giuda generò Fares e Zara da Tamar, Fares generò Esròm, Esròm generò Aram,
[Mat 1,4] Aram generò Aminadàb, Aminadàb generò Naassòn, Naassòn generò Salmòn,
[Mat 1,5] Salmòn generò Booz da Racab, Booz generò Obed da Rut, Obed generò Iesse,
I use this macro (http://www.vbaexpress.com/forum/showthread.php?t=5106) for merging this two document in a new document.
[vba]
Sub MergeNotes()
Dim docBook As Document
Dim docMerge As Document
Dim paraVerse As Paragraph
Dim rngVerse As Range
Dim BookVerseAndChapter
Dim VerseAndChapter
Dim abbrBook As String
Dim numBookChapter As Long
Dim numBookVerse As Long
Set docBook = Documents("Book.doc") ' Name of the Book Document
Set docNotes = Documents("Notes.doc") ' Name of the Notes Document
Set docMerge = Documents.Add
numNotesPara = 0
GetNextNote
For Each paraVerse In docBook.Paragraphs
Set rngVerse = paraVerse.Range
rngVerse.MoveEndWhile vbCr & Space(1), wdBackward
BookVerseAndChapter = Split(rngVerse, , 3)
abbrBook = BookVerseAndChapter(0)
VerseAndChapter = Split(BookVerseAndChapter(1), ":")
numBookChapter = Val(VerseAndChapter(0))
numBookVerse = Val(VerseAndChapter(1))
With docMerge
.Range(.Content.End - 1, .Content.End - 1) = rngVerse.Text
If Not rngNote Is Nothing Then
Do While numBookChapter = numNoteChapter And numBookVerse = numNoteVerse
.Range(.Content.End - 1, .Content.End - 1) _
= " {" & abbrBook & " " & numNoteChapter & "," & _
numNoteVerse & " " & rngNote.Text & "}"
GetNextNote
If rngNote Is Nothing Then Exit Do
Loop
End If
.Range(.Content.End - 1, .Content.End - 1) = vbNewLine
End With
Next
Set rngNote = Nothing
Set rngVerse = Nothing
Set docMerge = Nothing
Set docNotes = Nothing
Set docBook = Nothing
End Sub
Sub GetNextNote()
Dim ChapterAndVerse
Do
numNotesPara = numNotesPara + 1
If numNotesPara > docNotes.Paragraphs.Count Then
Set rngNote = Nothing
Exit Do
Else
Set rngNote = docNotes.Paragraphs(numNotesPara).Range
If Trim(rngNote.Text) <> vbCr Then Exit Do
End If
Loop
If Not rngNote Is Nothing Then
ChapterAndVerse = Split(Split(Split(Split(rngNote.Text, "]")(0), "[")(1))(1) & ",1", ",")
numNoteChapter = Val(ChapterAndVerse(0))
numNoteVerse = Val(Split(ChapterAndVerse(1), "-")(0))
rngNote.MoveStartUntil "]", wdForward
rngNote.MoveStartWhile "]" & Space(1), wdForward
rngNote.MoveEndWhile vbCr & Space(1), wdBackward
End If
End Sub
[/vba]
J have this problem: How preserve the formatting (color, bold, font and others) of the texts in the new document?
thanks pasquale
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules