Есть код, который адаптировал из макроса под vb6. Он синонимизимрует текст. Но работает очень медленно. Может кто то подскажет как ускорить?
Dim WordApp As Word.Application
Dim DocWord As Word.Document
Dim mySi As SynonymInfo
Dim hey As String
Private Sub Command1_Click()
Set WordApp = New Word.Application
Set DocWord = WordApp.Documents.Add
WordApp.Visible = False
DocWord.Application.Selection.InsertAfter Text1
WordApp.Visible = False
'Application.ScreenUpdating = False
On Error Resume Next
'GoTo ErrorHandler
Randomize
Dim re As RegExp
Set re = CreateObject("VBScript.RegExp")
КолличествоПропусков = 0
For Each curWord In DocWord.Words
w = Trim(curWord.Text)
re.Pattern = "^[\-à-ÿÀ-ߨ¸a-zA-Z]*$"
If re.Test(w) Then
If passer < 1 Then
If Z = 0 Then
'passer = Int(2 + Rnd * 3)
passer = 1 + КолличествоПропусков
Debug.Print w
Dim mySi As SynonymInfo
Set mySi = curWord.SynonymInfo
If mySi.MeaningCount > 0 Then
Z = 1
synList = mySi.SynonymList(Meaning:=1)
ind = Int(Rnd * UBound(synList)) + 1
s = synList(ind)
re.Pattern = "[^\-à-ÿÀ-ߨ¸a-zA-Z]"
If Not re.Test(s) Then
curWord.Text = s & " "
hey = hey & curWord.Text
Else
Z = countSpaces(w)
End If
Debug.Print s
End If
Set mySi = Nothing
Else
Z = Z - 1
End If
End If
End If
passer = passer - 1
ErrorHandler:
Next
Text1 = hey
End Sub
Function countSpaces(w)
c = 0
For i = 1 To Len(w)
If Mid(w, i, 1) = " " Then
c = c + 1
End If
Next
countSpaces = c
End Function
Основное время съедает w = Trim(curWord.Text), но чем это заменить не знаю.
Ответить
|