Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макросы выдаёт ошибку надо вылечить - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Макросы выдаёт ошибку надо вылечить (макрос вқдаёт ошибку)
Макросы выдаёт ошибку надо вылечить
tulakov77 Дата: Четверг, 10.03.2022, 15:26 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 48
Репутация: 0 ±
Замечаний: 60% ±

Здраствуйте, три макроса в ворде я пробовал не работет, при выполнения макроса ворд занова вернёться в VBA. Я навичок в этой теме по моего мнения в результате макрос должно кодироват текст или вроде того

[vba]
Код
Sub Antiplagiat()
Dim oRng As Range, i&, IsEnd As Boolean
Dim iStart& 'Переменная для ограничения нижней границы поиска
Do While Not IsEnd 'Продолжаем поиск пока флаг установлен
With ActiveDocument.Range(iStart, ActiveDocument.Range.End).Find 'Ищем слово, которое может состоять только из латинских или кириллических букв
.Text = "<[A-za-zА-ЯЁа-яё]@>"
.MatchWildcards = True
.Execute
If .Found Then 'слово найдено
Set oRng = .Parent 'Найденная часть документа
'----------------------------------------------------
If Len(oRng.Text) <= 8 And Len(oRng.Text) > 1 Then
oRng.Characters(oRng.Characters.Count \ 2).InsertAfter " "
ElseIf Len(oRng.Text) > 8 Then
oRng.Characters(oRng.Characters.Count \ 3).InsertAfter " "
oRng.Characters(oRng.Characters.Count * 2 \ 3).InsertAfter " "
End If
'----------------------------------------------------
'Перед каждым символом в слове, кроме первого, вставляем пробел
For i = oRng.Characters.Count To 2 Step -1
oRng.Characters(i).InsertBefore " "
Next
'Нижнюю границу поиска переносим в конец слова уже с учетом добавленных пробелов
iStart = oRng.End
'В слове, разделенном пробелами делаем величину шрифта для пробелов равной 1
With oRng.Find .Text = " "
.Replacement.Font.Size = 1
.Execute Replace:=wdReplaceAll
End With Else: IsEnd = True
'Если слово не было найдено, выходим из цикла
End If
End With
Loop
End Sub

Sub AntiPlagiat1()
With ActiveDocument.Range
.Find .Text = "([A-Za-zА-Яа-яЁё])([A-Za-zА-Яа-яЁё])": .MatchWildcards = True
.Replacement.Text = "\1#$&@\2" .Execute Replace:=wdReplaceAll
.Text = "#$&@": .MatchWildcards = False
.Replacement.Text = " ": .Replacement.Font.Size = 1
.Execute Replace:=wdReplaceAll
End With
End Sub

Sub antiplagiat2()
Dim oRng As Range, i&, IsEnd As Boolean
Dim iStart&
Do While Not IsEnd
With ActiveDocument.Range(iStart, ActiveDocument.Range.End).Find
.Text = "<[а-я]@>" .MatchWildcards = True
.Execute
If .Found Then Set oRng = .Parent
If Len(oRng.Text) > 8 Then
oRng.Characters(7).InsertAfter ChrW(1072) 'Ну или любой другой
With oRng.Characters(8)
.Font.Size = 1
End With
End If
iStart = oRng.End
Else: IsEnd = True
End If
End With
Loop
Selection.WholeStory
Selection.LanguageID = wdRussian
Selection.NoProofing = True
Application.CheckLanguage = True
End Sub
[/vba]
К сообщению приложен файл: 5273243.docx(12.4 Kb) · 1519441.docx(14.8 Kb)


Сообщение отредактировал tulakov77 - Пятница, 11.03.2022, 09:37
 
Ответить
СообщениеЗдраствуйте, три макроса в ворде я пробовал не работет, при выполнения макроса ворд занова вернёться в VBA. Я навичок в этой теме по моего мнения в результате макрос должно кодироват текст или вроде того

[vba]
Код
Sub Antiplagiat()
Dim oRng As Range, i&, IsEnd As Boolean
Dim iStart& 'Переменная для ограничения нижней границы поиска
Do While Not IsEnd 'Продолжаем поиск пока флаг установлен
With ActiveDocument.Range(iStart, ActiveDocument.Range.End).Find 'Ищем слово, которое может состоять только из латинских или кириллических букв
.Text = "<[A-za-zА-ЯЁа-яё]@>"
.MatchWildcards = True
.Execute
If .Found Then 'слово найдено
Set oRng = .Parent 'Найденная часть документа
'----------------------------------------------------
If Len(oRng.Text) <= 8 And Len(oRng.Text) > 1 Then
oRng.Characters(oRng.Characters.Count \ 2).InsertAfter " "
ElseIf Len(oRng.Text) > 8 Then
oRng.Characters(oRng.Characters.Count \ 3).InsertAfter " "
oRng.Characters(oRng.Characters.Count * 2 \ 3).InsertAfter " "
End If
'----------------------------------------------------
'Перед каждым символом в слове, кроме первого, вставляем пробел
For i = oRng.Characters.Count To 2 Step -1
oRng.Characters(i).InsertBefore " "
Next
'Нижнюю границу поиска переносим в конец слова уже с учетом добавленных пробелов
iStart = oRng.End
'В слове, разделенном пробелами делаем величину шрифта для пробелов равной 1
With oRng.Find .Text = " "
.Replacement.Font.Size = 1
.Execute Replace:=wdReplaceAll
End With Else: IsEnd = True
'Если слово не было найдено, выходим из цикла
End If
End With
Loop
End Sub

Sub AntiPlagiat1()
With ActiveDocument.Range
.Find .Text = "([A-Za-zА-Яа-яЁё])([A-Za-zА-Яа-яЁё])": .MatchWildcards = True
.Replacement.Text = "\1#$&@\2" .Execute Replace:=wdReplaceAll
.Text = "#$&@": .MatchWildcards = False
.Replacement.Text = " ": .Replacement.Font.Size = 1
.Execute Replace:=wdReplaceAll
End With
End Sub

Sub antiplagiat2()
Dim oRng As Range, i&, IsEnd As Boolean
Dim iStart&
Do While Not IsEnd
With ActiveDocument.Range(iStart, ActiveDocument.Range.End).Find
.Text = "<[а-я]@>" .MatchWildcards = True
.Execute
If .Found Then Set oRng = .Parent
If Len(oRng.Text) > 8 Then
oRng.Characters(7).InsertAfter ChrW(1072) 'Ну или любой другой
With oRng.Characters(8)
.Font.Size = 1
End With
End If
iStart = oRng.End
Else: IsEnd = True
End If
End With
Loop
Selection.WholeStory
Selection.LanguageID = wdRussian
Selection.NoProofing = True
Application.CheckLanguage = True
End Sub
[/vba]

Автор - tulakov77
Дата добавления - 10.03.2022 в 15:26
китин Дата: Четверг, 10.03.2022, 15:31 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 6895
Репутация: 1056 ±
Замечаний: 0% ±

Excel 2007;2010;2016
не гланем. делать нам нечего, что ли? здесь пишете, здесь и размещайте. и название темы смените.


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
Сообщениене гланем. делать нам нечего, что ли? здесь пишете, здесь и размещайте. и название темы смените.

Автор - китин
Дата добавления - 10.03.2022 в 15:31
китин Дата: Пятница, 11.03.2022, 07:39 | Сообщение № 3
Группа: Модераторы
Ранг: Экселист
Сообщений: 6895
Репутация: 1056 ±
Замечаний: 0% ±

Excel 2007;2010;2016
tulakov77, - Прочитайте Правила форума
- Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 500 кб согласно п.3 Правил форума


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
Сообщениеtulakov77, - Прочитайте Правила форума
- Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 500 кб согласно п.3 Правил форума

Автор - китин
Дата добавления - 11.03.2022 в 07:39
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Макросы выдаёт ошибку надо вылечить (макрос вқдаёт ошибку)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!