There is any solution for making a dictionary from one rtf file?
TWImporter can do a new module only from folder with many files.
Dictionary from one rtf file
Re: Dictionary from one rtf file
I have some MS Word macros that do split big files in smaller ones, but I do customize them every time, they are not generic. Would these help?
Costas
Costas
Re: Dictionary from one rtf file
Maybe.
May you send me them to my mail?
May you send me them to my mail?
Re: Dictionary from one rtf file
I will post here as attachments since more people may be interested,
Costas
Costas
Re: Dictionary from one rtf file
This is some code that will break a big rtf file on every paragraph that starts with a Hebrew letter.
You need to find a proper 'separator', e.g. something that identifies the beginning of each topic (e.g. bold, font-size, etc, MS Word can locate almost anything)
HTH,
Costas
You need to find a proper 'separator', e.g. something that identifies the beginning of each topic (e.g. bold, font-size, etc, MS Word can locate almost anything)
HTH,
Costas
Code: Select all
Sub SplitSingleDoc()
Dim i, j, v As Integer
Dim r As Range
Dim PS() As Long
Dim s As String
Selection.HomeKey Unit:=wdStory
ReDim Preserve PS(1) 'selections beginnings
j = 1
For i = 1 To ActiveDocument.Paragraphs.Count
'Debug.Print ActiveDocument.Paragraphs(i).Format.FirstLineIndent
'read the first word
Set r = ActiveDocument.Range( _
Start:=ActiveDocument.Paragraphs(i).Range.Start, _
End:=ActiveDocument.Paragraphs(i).Range.Start)
r.Expand Unit:=wdWord ', Count:=1, Extend:=wdExtend
s = r.Text
v = AscW(Mid(s, 1, 1))
If (v >= 1425 And v <= 1524) Or (v >= 64286 And v <= 64335) Then
PS(j) = r.Start
j = j + 1
ReDim Preserve PS(j)
End If
'Debug.Print s
'Debug.Print AscW(Mid(s, 1, 1))
Next i
For i = 1 To UBound(PS)
Selection.Start = PS(i)
'filename is the hebrew word
Selection.Expand Unit:=wdWord
s = Selection.Text
's = Trim(s)
'set the selection
Selection.Start = PS(i)
If i < UBound(PS) Then
Selection.End = PS(i + 1)
Else
Selection.MoveEnd wdStory, 1
End If
Selection.Copy
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
NewDocName = ActiveDocument.Name
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory 'move to beginning of doc
ChangeFileOpenDirectory "h:\dev\work\"
ActiveDocument.SaveAs FileName:=s, FileFormat:=wdFormatRTF, _
AddToRecentFiles:=False
Windows.Application.ActiveWindow.Close
Continue:
Next i
End Sub