[Iska]

Держите:

читать дальше »

Код:

Option Explicit

Sub ScanCrossword()
    Dim objDictionary As Object
    Dim objCell As Cell
    
    
    Set objDictionary = CreateObject("Scripting.Dictionary")
    
    With objDictionary
        ' 1-я строка
        .Add 1, CreateObject("Scripting.Dictionary")
        
        With .Item(1)
            .Add 1, "Д"
            .Add 2, "Е"
            .Add 3, "Р"
            .Add 4, "Е"
            .Add 5, "В"
            .Add 6, "О"
        End With
        
        ' 2-я строка
        .Add 2, CreateObject("Scripting.Dictionary")
        
        With .Item(2)
            .Add 1, "Е"
        End With
        
        ' 3-я строка
        .Add 3, CreateObject("Scripting.Dictionary")
        
        With .Item(3)
            .Add 1, "К"
        End With
    End With
    
    If ThisDocument.Tables.Count > 0 Then
        For Each objCell In ThisDocument.Tables.Item(1).Range.Cells
            With objCell
                If UCase(Left(.Range.Text, Len(.Range.Text) - 2)) <> UCase(objDictionary.Item(.RowIndex).Item(.ColumnIndex)) Then
                    MsgBox "Ошибка"
                    
                    Exit Sub
                End If
            End With
        Next
        
        MsgBox "Успешный результат"
    Else
        MsgBox "Кто-то взял да и удалил кроссворд вместо его заполнения"
    End If
End Sub