1 Тема от The gray Cardinal

  • The gray Cardinal
  • Разработчик
  • Неактивен

Тема: VBScript: проверка орфографии через Word.Application

Скрипт проверяет орфографию текста, находящегося в буфере обмена. Исправленный текст после проверки копируется туда же. Для работы скрипта необходим установленный MS Word.

On Error Resume Next
Set oWD = WScript.CreateObject("Word.Application")
oWD.Visible = False
oWD.Documents.Add
oWD.Selection.Paste
If Err.number <> 0 Then
    MsgBox "Буфер обмена пуст!"
    oWD.ActiveDocument.Close wdDoNotSaveChanges
    oWD.Quit
    Set oWD = Nothing
    Set oWD = Nothing
    WScript.Quit
End If
Set RangeOriginal = oWD.ActiveDocument.Range(0, oWD.Selection.End)
If oWD.CheckSpelling(RangeOriginal) = False Then
    oWD.ActiveDocument.CheckSpelling
    Set RangeCorrected = oWD.ActiveDocument.Range(0, oWD.Selection.End)
    RangeCorrected.copy
    If RangeCorrected.Words.Count > 7 Then
        Cnt = RangeCorrected.Words.Count
        Status = "Текст, начинающийся с: " & _
        RangeCorrected.Words.Item(1) & " " & RangeCorrected.Words.Item(2) & " " & _
        RangeCorrected.Words.Item(3) & "....." & vbCRLF & "и заканчивающийся: ....." & _
        RangeCorrected.Words.Item (Cnt - 2) & " " & RangeCorrected.Words.Item(Cnt - 1) & _
        " " & RangeCorrected.Words.Item(Cnt) & vbCRLF & "проверен. " & _
        "Исправленный текст скопирован в буфер обмена."
    Else
        Status = "<< " & RangeCorrected & " >>" & vbCRLF & "был проверен." & _
        " Исправленный текст скопирован в буфер обмена."
    End If 
Else
    Status = "Проверка завершена. Текст не содержит ошибок."
End If
oWD.ActiveDocument.Close wdDoNotSaveChanges
oWD.Quit
Set oWD = Nothing
MsgBox Status

Скрипт опубликовал tubudum.

Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.

2 Ответ от The gray Cardinal

  • The gray Cardinal
  • Разработчик
  • Неактивен

Re: VBScript: проверка орфографии через Word.Application

Поскольку Application.Selection может меняться в процессе проверки, скрипт выше может приводить иногда к неожиданным результатам. Улучшенный вариант скрипта от alexii, без использования Application.Selection.

' Скопируйте нижеследующий текст в буфер обмена для проверки работы скрипта:
' У папа была сабака, он её любыл, она зъела кусок мяса, он иё убыл.
'
' Если Вы соглашались на такие же замены при проверке орфографии, как и я,
' то получите в буфере обмена нижеследующий результат:
' У папа была собака, он её любил, она съела кусок мяса, он ее убыл.
'
' Обратите внимание, что «папа» и «убыл» считаются правильными с точки зрения орфографии
' и к замене, при проверке, не предлагаются.

Option Explicit

Const wdPasteText = 2
Const wdDoNotSaveChanges = 0

Dim objWord
Dim objDoc

Dim intErrorCode

intErrorCode = 0

Set objWord = WScript.CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add

With objDoc
    On Error Resume Next
    
    .Range.PasteSpecial 0, False, 0 ,False, wdPasteText
    
    If Err.Number = 0 Then
        On Error Goto 0
        
        If Not objWord.CheckSpelling(.Range.Text) Then
            .CheckSpelling
            .Range.Copy
        End If
    Else
        intErrorCode = 1
        WScript.Echo "В буфере обмена отсутствуют поддерживаемые форматы данных"
    End If
    
    .Close wdDoNotSaveChanges
End With

objWord.Quit wdDoNotSaveChanges

Set objDoc = Nothing
Set objWord = Nothing

WScript.Quit intErrorCode
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.