Помогите написать скрипт автозамены

[sashamo8]

Здравствуйте! Помогите пожалуйста написать макрос котрый находит весь текст с ефектом шрифта "Прописные" и заменяет етот текст на текст с заглавными буквами. Хорошо было бы написать етот скрипт для модуля "Альтернативный поиск и замена" с помощю регулярных виражений.

С уважением Александр

[JohnSUN]

Помогите пожалуйста написать макрос котрый находит весь текст с ефектом шрифта "Прописные" и заменяет етот текст на текст с заглавными буквами.

Код Выделить Развернуть

REM Заменить фрагменты текста с эффектом символов "Прописные"
REM на текст заглавными буквами. Эффект удалить.
Sub replacePseudoCAPS
Dim oSDesc As Variant
Dim resSrch
Dim foundText
Dim I&
Dim chrCaseMap(0) as new com.sun.star.beans.PropertyValue
chrCaseMap(0).Name = "CharCaseMap"
chrCaseMap(0).Value = com.sun.star.style.CaseMap.UPPERCASE

oSDesc = ThisComponent.createSearchDescriptor()
oSDesc.setSearchAttributes(chrCaseMap)

resSrch = ThisComponent.findAll(oSDesc)
For I = 0 To resSrch.getCount()-1
foundText = resSrch.getByIndex(I)
foundText.setString(UCase(foundText.getString()))
foundText.setPropertyValue( chrCaseMap(0).Name, com.sun.star.style.CaseMap.NONE)
Next I
End Sub

Хорошо было бы написать етот скрипт для модуля "Альтернативный поиск и замена" с помощю регулярных виражений.

Как ты себе это представляешь?

[sashamo8]

Тестирую на машине с OOWriter 3.0.0 че то не отрабатывается даный скрипт

[JohnSUN]

Я писал и проверял под LO 3.6.1.2 и AOO 3.4.1

[Hasim]

Попробуйте это, содрано отсюда http://www.darwinwars.com/oo_main.html

Код Выделить Развернуть

Sub CaseChanger
' silly macro by Andrew Brown
' This works like the corresponding command in MS Word, though only on single words:
' if you assign it to a key, successive key presses
' will cycle through upper case, lower case and title case.
Dim oDocument, oDesktop as Object
Dim oText as Object
Dim oVCursor, oCursor As Object
Dim sWombat as string
' the two following lines get the active document
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDocument= ThisComponent 'oDesktop.getCurrentComponent()
oText = oDocument.Text
oVCursor = oDocument.currentcontroller.getViewCursor()
oCursor = oText.createTextCursorByRange(oVCursor.getstart())

'oCursor.gotoStartOfWord(false)
'oCursor.gotoEndOfWord(true)

oCursor.gotoStartOfParagraph(false)
oCursor.gotoEndOfParagraph(true)

' the next routine checks if the word has several cases in it,
' and irons them out. Otherwise everything works erratically lower down
if oCursor.GetPropertyState("CharCaseMap")>0 then
oCursor.SetPropertyToDefault("CharCaseMap")
oCursor.CharCaseMap=2
end if
sWombat=oCursor.getPropertyValue("CharCaseMap")
'msgbox "CharCaseMap is now " + sWombat
if sWombat="1" then ' we have lowercase text
oCursor.CharCaseMap = com.sun.star.style.CaseMap.TITLE
elseif sWombat="2" then ' already title case
oCursor.CharCaseMap=com.sun.star.style.CaseMap.UPPERCASE
elseif sWombat="3" then ' we have uppercase
oCursor.CharCaseMap = com.sun.star.style.CaseMap.LOWERCASE
else
oCursor.SetPropertyToDefault("CharCaseMap")
end if
End Sub

прописные и заглавные - это одно и тоже

строчные заменяет на заглавные (прописные)

[Yakov]

У меня макрос JohnSUN`а  отлично отработал и на OpenOffice 2.2 и на OpenOffice 3.1

Единственное, для наглядности макросу не хватает 1 строчки перед End Sub:

Код Выделить Развернуть

MsgBox("Ок")
Для того, чтоб сказать пользователю, что макрос выполнился.

[sashamo8]

Извините наверное заработался. Сегодня макрос частично работает но часть текста все равно не обрабатывается. Попробуйте прикрепленный мною текст. там есть подзаголовок «Ваша дочка «з'їсть» весь бюджет»... — ести слова должны быть заменены на просные а не просто с ефектом прописных.

Сейчас вот поексперементировал: два макросы обрабатывают примерно так: если выделенно несколько абзацев то в первом или втором абзаце макрос отрабатывает а последующие абзацы игнорируются. Надо придумать так чтоб весь выделеный текст обрабатывался, а не там только где стоит курсор или первые абзацы. Прикрепляю весь текст. Попробуйте на нем макросы, может удастся улучшить? Заранее благодарю за труды участников етой ветки!


[вложение удалено Администратором]

[Hasim]

Если в содранном макросе заменить строки

Код Выделить Развернуть

'oCursor.gotoStartOfWord(false)
'oCursor.gotoEndOfWord(true)

oCursor.gotoStartOfParagraph(false)
oCursor.gotoEndOfParagraph(true)
на строки

Код Выделить Развернуть

oCursor.gotoStart(false)
oCursor.gotoEnd(true)
то обрабатывает весь документ.
OpenOffice.org pro 3.3.0 ("Инфра-ресурс")


[вложение удалено Администратором]

[JohnSUN]

Ох, Александр... Будь добр, включи проверку правописания! Это же невозможно читать: ести, просные, ефектом... (Або пиши вже українською та перекладай за допомогою http://translate.google.com.ua - цей суржик може використовувати премьер, а не порядні люди)

"Ошибка" в макросе связана с неточной постановкой задачи: ты писал о шрифте с эффектом "Прописные", а в качестве образцов для тестирования даешь тексты, в которых этот эффект применен не к символам, а к стилю PidzagFreSetC. Значит и искать нужно чуть иначе, по именам стилей в которых этот эффект установлен. В твоих образцах он всего один, но нет никаких гарантий, что в реальных документах так и будет... Значит, макрос должен перебирать все используемые в документе стили, для каждого, в котором эффект шрифта установлен в "Прописные", осуществлять поиск по документу, в найденных фрагментах менять символы на UpperCase... И, скорее всего, в стиле этот эффект нужно отключать. Или не нужно?

[Hasim]

Прописной буквой называется заглавная буква в предложении. Маленькая буква того же шрифта называется строчной.

Заглавная, или прописная буква — буква, которая увеличена в размере в сравнении со строчными буквами.

Менять "прописные" на "заглавные" значит "ничего не нужно менять".

[JohnSUN]

Я же и говорю, что формулировки Александра воспринимаются с трудом...

Речь с самого начала шла о названии эффекта

[вложение удалено Администратором]

[JohnSUN]

В общем, получается что-то в этом роде:

Код Выделить Развернуть

REM Заменить фрагменты текста с эффектом символов "Прописные"
REM на текст заглавными буквами. Эффект удалить.
Sub replacePseudoCAPS
Dim oDoc As Variant
Dim oSDesc As Variant
Dim resSrch
Dim foundText
Dim I&, J&, K&, cnt&, nCount&
Dim sRes$
Dim oStyleFamilies As Variant
Dim oStyleType As Variant
Dim oStyle As Variant
Dim stName$
Dim aProperty As New com.sun.star.beans.Property
Dim chrCaseMap(0) as new com.sun.star.beans.PropertyValue
chrCaseMap(0).Name = "CharCaseMap"
chrCaseMap(0).Value = com.sun.star.style.CaseMap.UPPERCASE
oDoc = ThisComponent
oSDesc = oDoc.createSearchDescriptor()
oSDesc.setValueSearch(false)
oSDesc.setSearchAttributes(chrCaseMap)
resSrch = oDoc.findAll(oSDesc)
sRes = "Обработка завершена:"+Chr(10)
cnt = resSrch.getCount()
If cnt > 0 Then
For I = 0 To cnt-1
foundText = resSrch.getByIndex(I)
foundText.setString(UCase(foundText.getString()))
foundText.setPropertyValue( chrCaseMap(0).Name, com.sun.star.style.CaseMap.NONE)
Next I
sRes = sRes+"прямое форматирование - "+cnt+" фрагментов"+Chr(10)
EndIf
REM Здесь закончился старый макрос (с поправкой от Yakov) - прямое применение эффекта к тексту
REM Теперь нужно отыскать стили, для которых установлен этот же эффект и изменить текст,
REM к которому применены эти стили
oSDesc = oDoc.createSearchDescriptor()
oSDesc.setPropertyValue("SearchStyles",True)
oStyleFamilies = oDoc.getStyleFamilies()
For K = 0 To oStyleFamilies.getCount()-1
oStyleType = oStyleFamilies.getByIndex(K)
For J = 0 To oStyleType.getCount()-1
oStyle = oStyleType.getByIndex(J)
If  oStyle.getPropertySetInfo().hasPropertyByName("CharCaseMap") Then
If oStyle.CharCaseMap = com.sun.star.style.CaseMap.UPPERCASE Then
stName = oStyle.getName()
oSDesc.setSearchString(stName)
resSrch = oDoc.findAll(oSDesc)
cnt = resSrch.getCount()
If cnt > 0 Then
For I = 0 To cnt-1
foundText = resSrch.getByIndex(I)
foundText.setString(UCase(foundText.getString()))
REM Здесь - если надо - из стиля убирается эффект Прописные
Next I
sRes = sRes+"стиль "+stName()+" - "+cnt+" фрагментов"+Chr(10)
EndIf
EndIf
EndIf
Next J
Next K
If Len(sRes)<25 Then
sRes = sRes+"текст с эффектом Прописные не обнаружен"
Else
sRes = sRes+"Все обнаруженные фрагменты изменены на заглавные буквы"
EndIf
MsgBox(sRes)
End Sub


[sashamo8]

JohnSUN спасибо теперь все заработало. Извините за ошибки (украинской многие могут не понять так как форум российский) стараюсь грамотнее писать просто иногда спешу, время как всегда поджимает.
С формулировкой немного неполно наверное выразился (много было писать). Просто ситуация такова что есть верстка в КваркПресе и ее надо максимально сохраняя форматирование перенести на наш сайт. Все что имеет эфект "Прописных" букв на сайт ставится строчными вот я и затеял этот сыр-бор с макросом. Теперь с помощью макроса от JohnSUN будем переводить.

Всем ответившим спасибо! Отдельное спасибо JohnSUN !

С уважением Александр