Set WordApplication = New Word.Application
WordApplication.Documents.Add
WordApplication.Visible = False
WordApplication.Selection.Text = rtbMain.Text
WordApplication.ActiveDocument.CheckSpelling
rtbMain.Text = WordApplication.Selection.Text
WordApplication.ActiveDocument.Close wdDoNotSaveChanges
WordApplication.Quit
Set WordApplication = Nothing
При нажатии "Отмена" текст из RichTextBox пропадает. Как сделать, чтоб
не пропадал? И еще, при окончании проверки мигает окно Word. Как
сдедать, чтоб не моргало?
gvozd, вот вполне рабочий пример проверки орфографии. Нужно в ссылках подключить Microsoft Word 11.0 Object Library, или Microsoft Word 10.0 Object Library.
Option Explicit
 im appWord As Word.Application
 im VariantColl As SpellingSuggestions
 im OldSelStart As Long
 im CheckCount As Long
 im SelStart As Long
Private Sub Form_Load()
CheckCount = 1
If appWord Is Nothing Then
Set appWord = GetObject("", "Word.Application"
appWord.Documents.Add
Else
Set VariantColl = Nothing
Set appWord = Nothing
Set appWord = GetObject("", "Word.Application"
appWord.Documents.Add
End If
End Sub
Private Sub CheckSpelling()
With appWord.Selection
.WholeStory
.Delete Unit:=wdCharacter, Count:=1
.InsertAfter rtb.Text
End With
Check
End Sub
Private Sub Check()
 im i As Long
With appWord.Selection.Range
If .SpellingErrors.Count > 0 Then
SelStart = InStr(rtb.Text, .SpellingErrors.Item(CheckCount).Text) - 1
rtb.SelStart = SelStart
rtb.SelLength = Len(.SpellingErrors.Item(CheckCount).Text)
rtb.SelColor = vbRed
rtb.SelLength = 0
rtb.SelStart = OldSelStart
rtb.SelColor = vbBlack
Set VariantColl = appWord.GetSpellingSuggestions(.SpellingErrors.Item(CheckCount))
lstVariant.Clear
If VariantColl.Count > 0 Then
For i = 1 To VariantColl.Count
lstVariant.AddItem VariantColl.Item(i).Name
Next i
Else
lstVariant.AddItem "нет вариантов)"
End If
Else
lstVariant.Clear
lstVariant.AddItem "ошибок не найдено)"
End If
End With
End Sub
Private Sub cmdPass_Click()
If lstVariant.List(0) = "ошибок не найдено)" Then
MsgBox "Нет ошибок.", vbInformation, "Внимание!"
Else
SelStart = InStr(rtb.Text, appWord.Selection.Range.SpellingErrors.Item(CheckCount).Text) - 1
With rtb
.SelStart = SelStart
.SelLength = Len(appWord.Selection.Range.SpellingErrors.Item(CheckCount).Text)
.SelColor = vbBlack
.SelLength = 0
.SelStart = OldSelStart
End With
If appWord.Selection.Range.SpellingErrors.Count > CheckCount Then
CheckCount = CheckCount + 1
Check
Else
With appWord.Selection
.WholeStory
.Delete Unit:=wdCharacter, Count:=1
.InsertAfter rtb.Text
End With
If appWord.Selection.Range.SpellingErrors.Count > CheckCount Then
CheckCount = CheckCount + 1
Check
Else
CheckCount = 1
lstVariant.Clear
lstVariant.AddItem "ошибок не найдено)"
MsgBox "Проверка орфографии завершена.", vbInformation, "Внимание!"
End If
End If
End If
End Sub
Private Sub cmdReplace_Click()
 im i As Long
If lstVariant.List(0) = "нет вариантов)" Then
MsgBox "Нет вариантов.", vbInformation, "Внимание!"
ElseIf lstVariant.List(0) = "ошибок не найдено)" Then
MsgBox "Нет ошибок.", vbInformation, "Внимание!"
ElseIf lstVariant.ListIndex = -1 Then
MsgBox "Выберите вариант", vbExclamation, "Внимание!"
Else
SelStart = InStr(rtb.Text, appWord.Selection.Range.SpellingErrors.Item(CheckCount).Text) - 1
With rtb
.SelStart = SelStart
.SelLength = Len(appWord.Selection.Range.SpellingErrors.Item(CheckCount).Text)
.SelColor = vbBlack
.SelText = lstVariant.Text
.SelLength = 0
.SelStart = OldSelStart
End With
If appWord.Selection.Range.SpellingErrors.Count > CheckCount Then
CheckCount = CheckCount + 1
Check
Else
CheckCount = 1
With appWord.Selection
.WholeStory
.Delete Unit:=wdCharacter, Count:=1
.InsertAfter rtb.Text
End With
If appWord.Selection.Range.SpellingErrors.Count > 0 Then
Check
Else
lstVariant.Clear
lstVariant.AddItem "ошибок не найдено)"
MsgBox "Проверка орфографии завершена.", vbInformation, "Внимание!"
End If
End If
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set VariantColl = Nothing
Set appWord = Nothing
End Sub
Private Sub rtb_KeyPress(KeyAscii As Integer)
OldSelStart = rtb.SelStart
If Len(rtb.Text) > 0 Then
If KeyAscii < 33 Then
CheckSpelling
End If
End If
End Sub