Macro word extraer palabras/diccionario

?aro
06 de Noviembre del 2003
Hola, necesito una macro de word a la q pasándole un texto me saque las palabras en castellano del mismo. Buscando por la red he conseguido este código, y lo he conseguido modificar hasta dejarlo así. El problema es q no puede con textos muy largos (+3000 palabras). He pensado q una solución sería q en vez de abrir dos ventanas de documento, y copiar las palabras de uno a otro, sería más eficiente borrarlas directamente del documento fuente, pero no sé como implementarlo en VB.

Aquí está el código.

Sub Macro1()
' ExtractNewWords Macro: Extracts words from your document
' that are not present in MS Word's spell-check dictionary
' Useful for terminology research
' Macro recorded on 14.08.02 by Tanya Harvey
'
' If no Word document is open
On Error GoTo MainStop
If Documents.Count = 0 Then
WordBasic.MsgBox "Open the document from which you wish to extract the words that are not present in MS Word's spell-check dictionary!"
Exit Sub
End If
' If more than one Word document is open
If Documents.Count > 1 Then
WordBasic.MsgBox "Close all Word documents and open only the document from which you wish to extract the words that are not present in MS Word's spell-check dictionary!"
Exit Sub
End If
' Declaration in confirmation dialogue box
Dim Prompt As String
Dim Title As String
Dim Response As String
Dim Style As Integer
Dim lingo As String
lingo = ActiveDocument.AttachedTemplate.LanguageID
For Each la In Languages
x = Application.Languages(la).ID
If x = lingo Then
lingo = la.NameLocal
End If
Next la
Prompt = "Is the language of your document <" + lingo$ + ">?" + Chr(13) + "(If not, click <No> and set the correct language!)" + Chr(13) + "" + Chr(13) + "This operation may take a while..."
Style = 36
Title = "Document language setting"
Response = MsgBox(Prompt, Style, Title)
If Response = vbNo Then
MsgBox "To set the language of your document, select:" + Chr(13) + "" + Chr(13) + "Edit/Select All" + Chr(13) + "Tools/Language/Set Language (select your language)" + Chr(13) + "Default/Yes/OK"
Exit Sub
Else
' Open a new document in which to save the words
Set doct = Documents.Add
' Arrange open windows
Windows.Arrange
' Activate the document from which to extract the terminology
Dim AnzahlFenster As Integer
Dim NummerAktivesFenster As Integer
AnzahlFenster = Application.Windows.Count
NummerAktivesFenster = Application.ActiveWindow.Index
If AnzahlFenster > NummerAktivesFenster Then
Application.ActiveWindow.Next.Activate
Else
Application.Windows(1).Activate
End If
' Select the entire content of the document
Selection.WholeStory
' For each word in the document do all instructions up to "Next"
For Each mot In Selection.Words
' If the word is not present in MS Word's spell-check dictionary
If mot.GetSpellingSuggestions.SpellingErrorType = wdSpellingInDictionary Then
' Activate the document listing the words extracted
doct.Activate
' Remove any additional spaces after the word
mot = Trim(mot)
' Type the word in the list…
Selection.TypeText mot
' … followed by a paragraph mark
Selection.TypeParagraph
End If
Next
WordBasic.MsgBox "End of spell check: All the words not present in MS Word's spell-check dictionary have been written to a separate file. Duplicates have been removed."
End If
MainStop:
If Err.Number <> 0 Then
MsgBox "An error has occurred. Make sure that the dictionary for the language of your document is installed (search your hard drive for <*.lex> to locate the dictionary files.)"
End If

Podéis ehcarme una mano. Muchas gracias!

?ro
06 de Noviembre del 2003
lo subo