Как сократить текст в Word'e по следующему алгоритму?

[Скрипт]

duh96, нужно тогда работать с символами, которые нужно не учитывать. К таким символам относятся: знаки препинания, скобки, кавычки, пробелы, знаки табуляции и другие. Нужно составить полный перечень таких специфических символов и использовать их здесь:

'1. Сначала заменяю слова с дефисом.
.Text = "<([А-Яа-яЁёA-Za-z])[А-Яа-яЁёA-Za-z]{1;}-([А-Яа-яЁёA-Za-z])[А-Яа-яЁёA-Za-z]{1;}>"

и здесь:

2. Удаляем из слова всё кроме первой буквы и ставим точку.
.Text = "<([А-Яа-яЁёA-Za-z])[А-Яа-яЁёA-Za-z]{1;}>"

Я пока не знаю, как всё это сделать.

[duh96]

Скрипт, а что, если в перечень символов, с которыми работает скрипт, просто дописать перечень казахских символов? Их не так уж и много! Вот они: ә, і, ң, ғ, ү, ұ, қ, ө, һ. Все остальные, такие же, как и русские.

Только как правильно это сделать...

Хотя "VBA" их не видит, т.е. вместо них ставит вопросы, кроме "Іі"

[Ципихович Эндрю]

между квадратных скобок
[А-Яа-яЁёA-Za-z]
все нужные символы по очереди, без тире, запятых и т. д.

[Скрипт]

Пункт 1

duh96, вот этот символ "і" воспринимается как английский символ "i", поэтому в коде я не добавлял этот символ.


Пункт 2

Новая версия кода с учётом некоторых казахских символов:

Sub Procedure_1()
    
    'Чтобы ускорить работу кода:
    '1) перейдите в режим "Черновик";
    '2) отключите проверку правописания.
    
    Dim myParagraph As Word.Paragraph
    Dim myArray As Variant
    Dim rngSearch As Word.Range
    Dim mySearchText_1 As String, mySearchText_2 As String
    Dim myKaz As String
    
    '1. Помещаем в переменную "myKaz" символы по Unicode-кодам символов.
    'Код символа можно так узнать:
        '1) перейдите в программу "Word";
        '2) выделите символ, у которого нужно узнать Unicode-номер;
        '3) перейдите в программу "VBA";
        '4) View - Immediate Window. Появится окно;
        '5) в окно вставьте вот этот код и нажмите клавишу "Enter":
            'print ascW(selection.Text)
        '6) будет получен Unicode-номер символа.
    
    'Символ "&" нужен для соединения фрагментов текста в одну строку.
    'Символ "_" нужен, чтобы текст кода не выходил за границы монитора,
        'чтобы было удобно читать и писать код.
    myKaz = ChrW(1241) & ChrW(1187) & ChrW(1171) & _
            ChrW(1199) & ChrW(1201) & ChrW(1179) & _
            ChrW(1257) & ChrW(1211)
    
    '2. Сформируем то, что будем искать, отдельно от кода, чтобы
        'было удобно писать код.
    mySearchText_1 = "<([А-Яа-яЁёA-Za-z" & myKaz & "])" & _
        "[А-Яа-яЁёA-Za-z" & myKaz & "]{1;}-" & _
        "([А-Яа-яЁёA-Za-z" & myKaz & "])[А-Яа-яЁёA-Za-z" & myKaz & "]{1;}>"
    
    mySearchText_2 = "<([А-Яа-яЁёA-Za-z" & myKaz & "])[А-Яа-яЁёA-Za-z" & myKaz & "]{1;}>"
    
'-----------------------------------------------------------------------------------------------
    '3. Сначала заменяю слова с дефисом.
    
    'Просматриваем все абзацы в документе.
    For Each myParagraph In ActiveDocument.Paragraphs
        
        '3.1. Задаём диапазон для поиска.
        Set rngSearch = myParagraph.Range
        
        '3.2. Определяем, нужно обрабатывать два предложения или только первое.
        'С помощью "Split" разбиваем абзац на две части.
        myArray = Split(rngSearch.Text, "... ")
        
        '3.3. Считаем, сколько пробелов во втором предложении.
            'Если три и более пробелов, то значит, что во втором предложении
            'больше трёх слов. В "Split" нумерация с нуля, поэтому не стыковка.
        If UBound(Split(myArray(1), " ")) < 2 Then
            'Двигаем конец абзаца в начало документа до троеточия.
            rngSearch.MoveEndUntil Cset:="...", Count:=wdBackward
        End If
        
        With rngSearch.Find
            '3.4. Ищем в начале слова русскую или английскую букву.
            'После буквы должно быть одна или несколько русских или английский букв.
            'Затем тире, а затем тоже самое, но наоборот.
            .Text = mySearchText_1
            'Оставляем то, что в круглых скобках и вставляем дефис.
            .Replacement.Text = "\1-\2"
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
        
    Next myParagraph


'-----------------------------------------------------------------------------------------------
    '4. Удаляем из слова всё кроме первой буквы и ставим точку.
    
    For Each myParagraph In ActiveDocument.Paragraphs
    
        Set rngSearch = myParagraph.Range
        
        myArray = Split(rngSearch.Text, "... ")
        
        If UBound(Split(myArray(1), " ")) < 2 Then
            rngSearch.MoveEndUntil Cset:="...", Count:=wdBackward
        End If
        
        With rngSearch.Find
            'Ищем в начале слова русскую или английскую букву.
            'Затем одну или несколько русских или английских букв и признак конца слова.
            .Text = mySearchText_2
            'Заменяем на то, что в круглых скобках и добавляем точку.
            .Replacement.Text = "\1."
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
        
    Next myParagraph
    
End Sub

Пункт 3

duh96, вам нужно найти в интернете таблицу символов "Unicode" и узнать, с какого номера начинаются нужные символы и на каком номере заканчиваются нужные символы. Коды символов нужно узнавать и для больших букв и для маленьких.

Я сейчас смотрел в интернете, коды символов в таблице "Unicode" в шестнадцатеричной системе исчисления. Можете прямо такие коды указать на Форуме. Я внесу изменения в макрос.

[Скрипт]

Ципихович Эндрю, я пока делаю вывод, что код макроса можно писать только ANSI-символами.

[Скрипт]

Другая версия кода:

1. поиск и замена русских букв ведётся в формате "Unicode";
2. не обрабатываются абзацы, в которых нет троеточия.

Sub Procedure_1()
    
    Dim myParagraph As Word.Paragraph
    Dim myArray As Variant
    Dim rngSearch As Word.Range
    Dim mySearchText_1 As String, mySearchText_2 As String
    Dim myRusKaz As String
    Dim rngEllipsisPosition As Word.Range
    Dim myEllipsisFind As Word.Find
    
    '1. Создаём инструменты для поиска троеточия.
    Set rngEllipsisPosition = ActiveDocument.Range(Start:=0, End:=0)
    Set myEllipsisFind = rngEllipsisPosition.Find
    myEllipsisFind.Text = "..."
    
    '2. Помещаем в переменную "myRusKaz" символы по Unicode-кодам символов.
    'Помещаю данные по русскому и казахскому языку, может ещё по какому языку.
    'Диапазон в таблице "Unicode" в шестнадцетеричной системе счисления: 400 — 4FF,
        'в десятичной системе счисления: 1024 - 1279.
    myRusKaz = ChrW(1024) & "-" & ChrW(1279)
    
    '3. Сформируем то, что будем искать.
    mySearchText_1 = "<([A-Za-z" & myRusKaz & "])" & "[A-Za-z" & myRusKaz & "]{1;}-" & _
                    "([A-Za-z" & myRusKaz & "])[A-Za-z" & myRusKaz & "]{1;}>"
    
    mySearchText_2 = "<([A-Za-z" & myRusKaz & "])[A-Za-z" & myRusKaz & "]{1;}>"
    
'-----------------------------------------------------------------------------------------------
    '4. Сначала заменяю слова с дефисом.
    
    'Просматриваем все абзацы в документе.
    For Each myParagraph In ActiveDocument.Paragraphs
        
        '4.1. Задаём диапазон для поиска.
        Set rngSearch = myParagraph.Range
        
        '4.2. Определяем, нужно обрабатывать два предложения или только первое.
        'С помощью "Split" разбиваем абзац на две части.
        myArray = Split(rngSearch.Text, "... ")
        
        '4.3. Пропускаем абзацы, в которых нет троеточия или если
            'больше одного троеточия.
        If UBound(myArray) = 0 Or UBound(myArray) > 1 Then
            GoTo metka_1
        End If
        
        '4.4. Считаем, сколько пробелов во втором предложении.
            'Если три и более пробелов, то значит, что во втором предложении
            'больше трёх слов. В "Split" нумерация с нуля, поэтому не стыковка.
        If UBound(Split(myArray(1), " ")) < 2 Then
            'Сужаем диапазон поиска и замены.
            'Ищем троеточие.
            rngEllipsisPosition.SetRange Start:=rngSearch.Start, End:=rngSearch.Start
            myEllipsisFind.Execute
            rngSearch.SetRange Start:=rngSearch.Start, End:=rngEllipsisPosition.Start
        End If
        
        With rngSearch.Find
            '4.5. Поиск и замена.
            .Text = mySearchText_1
            'Оставляем то, что в круглых скобках и вставляем дефис.
            .Replacement.Text = "\1-\2"
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
        
metka_1:

    Next myParagraph


'-----------------------------------------------------------------------------------------------
    '5. Удаляем из слова всё кроме первой буквы и ставим точку.
    
    For Each myParagraph In ActiveDocument.Paragraphs
    
        Set rngSearch = myParagraph.Range
        
        myArray = Split(rngSearch.Text, "... ")
        
        'Пропускаем абзацы, в которых нет троеточия или если
            'больше одного троеточия.
        If UBound(myArray) = 0 Or UBound(myArray) > 1 Then
            GoTo metka_2
        End If
        
        If UBound(Split(myArray(1), " ")) < 2 Then
            rngEllipsisPosition.SetRange Start:=rngSearch.Start, End:=rngSearch.Start
            myEllipsisFind.Execute
            rngSearch.SetRange Start:=rngSearch.Start, End:=rngEllipsisPosition.Start
        End If
        
        With rngSearch.Find
            .Text = mySearchText_2
            'Заменяем на то, что в круглых скобках и добавляем точку.
            .Replacement.Text = "\1."
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With

metka_2:
        
    Next myParagraph
    
End Sub

[duh96]

Скрипт, Последний код работает!

[Sasha_Smirnov]

Сообщение от Скрипт

Другая версия кода:

1. поиск и замена русских букв ведётся в формате "Unicode";
2. не обрабатываются абзацы, в которых нет троеточия.

Или оно есть, но одним символом (юникод 0133), как вот в этом примере:

Сообщение от duh96

7 раз отмерь… 1 раз отрежь

[duh96]

Скрипт, если Вам не трудно, напишите свою личную почту или агент.

[Скрипт]

duh96, троеточия ещё могут быть двух видов:

1. троеточие, составленное из трёх точек, где каждая точка считается точкой;
2. троеточие, представляющее собой один символ. Такое троеточие в программе "Word" появляется, когда ставишь три точки и программа "Word" заменяет три точки на один символ "троеточие". Это относится к автозамене и можно отключить или включить такую автозамену.

У меня код работает с первым случаем.