[CDR 2017-2022] Добавить слово реклама

  • Автор темы Автор темы izrukvruki
  • Дата начала Дата начала

izrukvruki

Топикстартер
15 лет на форуме
Сообщения
1 904
Реакции
335
Можно ли проверить, существует ли в рекламном модуле слово "Реклама", если нет, то добавить это слово?
 
Отличное ТЗ!
 
Вопрос до заканчивается словом "ли", дальше идёт ТЗ.
 
Поиск слова "Реклама" как делать?
 
А если слово откурвлено?
 
Текст искать... если откурвлено, то конечно не найдет ничего.
 
upload_2017-9-26_17-16-32.png
 
Объявку в битмап, битмап в распознавалку, поиск в результате, всё автоматизировать.
В объявках рекламных фирм, выставок и т.п. это слово может быть и в основном тексте - может центр битмапа выкусывать и распознавать только поля?
 
С макетами ничего делать не надо. Средством VBA можно искать фигурный текст "Реклама" (не кривая, не битмап, а просто фигурный текст)?
Для поиска имеет значение регистр: "Реклама" и "реклама"?
 
Искать можно, причем, припоминая Ваш же пост - [2017] - Анализ строк с кириллицей
поставим опыт: создаем несколько текстовок "реклама", в т.ч. и "серыми шрифтами" (Печать по-русски "серыми" шрифтами.)
прогоняем тест:
Код:
Sub aaa()
  Dim s As Shape
  m = ""
  For Each s In ActivePage.Shapes.FindShapes(, cdrTextShape)
    t = s.Text.Story
    m = m & vbCr & s.Text.Story.Font
    If s.Text.Find("реклама", True) Then m = m & vbCr & "0 " & t
    If t = "реклама" Then m = m & vbCr & "1 " & t
    If StrComp(t, "реклама", vbTextCompare) Then m = m & vbCr & "2 " & t
    If StrComp(t, "@5:;0<0", vbTextCompare) Then m = m & vbCr & "3 " & t
    m = m & vbCr
  Next s
  MsgBox m
End Sub
метод s.Text.Find у меня выдал верный результат на всех вариантах, "=" и StrComp не давали однозначного срабатывания, как в упомянутой теме
 
Последнее редактирование:
  • Спасибо
Реакции: izrukvruki
Вот так сделал:
Код:
Sub aaa()
  Dim s As Shape
  Dim reklama As Shape
  ActiveDocument.Unit = cdrMillimeter

  For Each s In ActivePage.Shapes.FindShapes(, cdrTextShape)
    t = s.Text.Story
    If t = "Реклама" Or t = "реклама" Then m = 1
  Next s
 
  If m <> 1 Then
    Set reklama = ActiveDocument.ActivePage.ActiveLayer.CreateArtisticText(0, 0, "Реклама")
                  reklama.Text.FontProperties.Name = "Fira Sans"
                  reklama.Text.FontProperties.Size = 5
                  reklama.RotateEx 90#, 90, 90
                  reklama.PositionX = ActiveDocument.ActivePage.SizeWidth - 1.8
                  reklama.PositionY = ActiveDocument.ActivePage.SizeHeight - 8
  End If
End Sub
 
Все макеты одного размера? Слово "реклама" может встречаться не в качестве самостоятельной сноски, а в самом тексте макета или в какой-либо юридической сноске. Может, стоит дополнительно проверять на шрифт, кегль, цвет надписи?
 
Ваш код не найдёт "рекламу" в клипах (мне для примера данная обвязка не нужна была)
оператор "=" сбойнёт на "сером шрифте" (забыл упомянуть его в своём посте), лучше использовать s.Text.Find("реклама", False)
(запостил пример с ошибкой "" вместо "реклама", сейчас поправил)
Из цикла перебора стоит выходить по Exit For сразу после нахождения "рекламы" и не продолжать перебирать остальные слова
 
  • Спасибо
Реакции: izrukvruki
Можно ли проверить, существует ли в рекламном модуле слово "Реклама", если нет, то добавить это слово?
Зачем перебирать все шейпы не понимаю.
Можно сделать проще, всегда добавлять слово реклама... к чему эти лишние проверки.
Или делать слово реклама отдельным топовым слоем и лочить его чтобы не накапливались дубли. Трудоемкость проверки в разы сокращается.
 
Все макеты одного размера? Слово "реклама" может встречаться не в качестве самостоятельной сноски, а в самом тексте макета или в какой-либо юридической сноске. Может, стоит дополнительно проверять на шрифт, кегль, цвет надписи?
Макеты разного размера. И разный цвет фона - черный шрифт по черному фону - тоже будет невиден... + на месте размещения "Реклама" может расположен "полезный текст" - далее уже руками передвинуть.
Хочется хоть как-то упростить и ускорить процесс.
А если "реклама" где встретится по тексту - то не добавится. Тогда вручную буду добавлять.
Ваш код не найдёт "рекламу" в клипах (мне для примера данная обвязка не нужна была)
оператор "=" сбойнёт на "сером шрифте" (забыл упомянуть его в своём посте), лучше использовать s.Text.Find("реклама", False)
(запостил пример с ошибкой "" вместо "реклама", сейчас поправил)
Из цикла перебора стоит выходить по Exit For сразу после нахождения "рекламы" и не продолжать перебирать остальные слова
В клипах искать и не надо, пусть лежит просто на слое. Серых шрифтов не должно быть. Обычно "служебную" информацию стараюсь набирать Pragmatica или Fire Sans
 
Подскажите, как сделать проверку на то, чтоб при добавлении слова "реклама" был открыт документ.
Хочется добавить защиту от дурака. Просто если вызвать макрос если все файлы закрыты - то будет ошибка...
 
Например так
Код:
 If Documents.Count = 0 Then Exit Sub
 
  • Спасибо
Реакции: izrukvruki
вариант:
Код:
If ActiveDocument Is Nothing Then Exit Sub
 
  • Спасибо
Реакции: izrukvruki