помогите адаптировать макрос из exel

[sergey.tsariov]

Вот тут лежит макрос для подсчета количества(суммы значения) ячеек по цвету
http://beerwolf.ru/2009/11/23/%D0%BA%D0%BE%D0%BB%D0%B8%D1%87%D0%B5%D1%81%D1%82%D0%B2%D0%BE-%D0%B8%D0%BB%D0%B8-%D1%81%D1%83%D0%BC%D0%BC%D0%B0-%D1%8F%D1%87%D0%B5%D0%B5%D0%BA-%D0%BE%D0%BF%D1%80%D0%B5%D0%B4%D0%B5%D0%BB%D0%B5%D0%BD/

Помогите приспособить к OpenOffice calc

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

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)

Dim rCell As Range

Dim lCol As Long

Dim vResult

''''''''''''''''''''''''''''''''''''''

'Written by Ozgrid Business Applications

'www.ozgrid.com

'Sums or counts cells based on a specified fill color.

'''''''''''''''''''''''''''''''''''''''

lCol = rColor.Interior.ColorIndex

If SUM = True Then

For Each rCell In rRange

If rCell.Interior.ColorIndex = lCol Then

vResult = WorksheetFunction.SUM(rCell,vResult)

End If

Next rCell

Else

For Each rCell In rRange

If rCell.Interior.ColorIndex = lCol Then

vResult = 1 + vResult

End If

Next rCell

End If

   ColorFunction = vResult

End Function

[JohnSUN]

Уточни, Сергей: помочь с адаптацией или переписать? Если действительно помочь, то в этом форуме на пятой странице (в смысле, на четвертой с конца) есть тема Фильтрация по цвету [MEMO].

PS. Добро пожаловать на форум!

[RFJ]

Вот так, например:

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

Function LC(c0,r0,c1,r1,c2,r2,bool)

oDoc=ThisComponent

'Варианты: активный лист, по имени листа, по номеру листа
oSheet=oDoc.CurrentController.getActiveSheet()
'oSheet=oDoc.Sheets.getByName("Лист1")
'oSheet=oDoc.Sheets(0)

col0=oSheet.getCellByPosition(c0-1, r0-1).CellBackColor

numcol=0

For n=c1-1 To c2-1
For k=r1-1 To r2-1
If oSheet.getCellByPosition(n, k).CellBackColor=col0 Then
If bool="false" Then
numcol=numcol+1
End If
If bool="true" Then
numcol=numcol+oSheet.getCellByPosition(n, k).getValue()
End If
End If
Next k
Next n

LC = numcol

End Function


Образцовая ячейка D1
Область для подсчета A1:D20


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

[sergey.tsariov]

c

от так, например:

Спасибо работает, только как-то странно: когда забиваю формулу она срабатывает, а вот при попытке перезагрузить файл(открыть файл заново) выскакивает ошибка "ошибка времени выполнения BASIC. Переменная типа Object не установленна"

[RFJ]

У меня ошибки не вылезают.
Windows XP, LibreOffice 3.4.2

Прикладываю свой файл.



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

[Рыбка Рио]

У меня ошибки не вылезают.

У меня тоже. LibO 3.4.3 + Ubuntu 11.04
Но в более ранних версиях возможно макрос пытается отработать быстрее чем открылся документ.
Строчка oSheet=oDoc.CurrentController.getActiveSheet() предполагает что документ уже открыт, видимо.

[Leojse]

Здравствуйте. Применяю ваш макрос к ячейкам. Считает по цветам, как нужно, но при изменении цвета ячейки (которую нужно досчитать), почему-то пересчет не происходит. Приходиться закрывать Calc, снова открывать и только тогда он пересчитывает. Возможно ли, чтобы при изменении цвета ячейки на образцовый формула пересчитывалась автоматически?

[JohnSUN]

Конечно, возможно! Просто допиши в конце формулы

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

+INT(RAND())
Функция RAND() вычисляется при каждом пересчете листа, при любом его изменении. А это заставляет Calc пересчитать и формулу, в которую этот RAND() включен. А функция INT() превратит результат этой функции в ноль.

[Leojse]

JohnSUN Спасибо большое!

[Leojse]

JohnSUN
Добрый вечер. Возник еще вопрос по макросу. Почему-то не могу его добавить в сам файл... В файле создаю Модуль, туда копирую код макроса, сохраняю, вроде всё хорошо. Но при повторном открытии файла в ячейках с суммой просто решетки, и внизу на панели около ползунка масштабирования написано:"Ошибка: макрос не найден". Захожу по alt-F11, а модуля с макросом нет... Могу добавить только в "Мои макросы" и там макрос сохранится. Но дело в том, что файлы я отправляю по почте, и получается, получатель видит только решетки вместо суммы ячеек... Подскажите, есть выход?
Open Office 3.2.1 инфра-ресурс
Формат файла xls, в файле присутствуют макросы vba (работают в openoffice нормально).

[Hasim]

Формат файла xls

В этом формате (xls - это из MS Office!) макросы из Open Office не сохраняются!
(Наоборот (макросы MS Office VBA в Open Office) сохраняются и работают, а вот так (макросы Open Office в MS Office) не сохраняются и не работают.)
Хотите распространять в формате XLS - пишите макросы на VBA.

[Leojse]

Hasim
Спасибо за пояснение.

[apt31]

Open Office 3.2.1 ни один макрос VBA не работает. Как ни загружай. Может в более поздних версиях. Но это вряд ли . Была бы сенсация.

[JohnSUN]

Нет, не ради сенсации...
Если, просто ради любопытства, заглянуть в тему Вышел OpenOffice.org 3.2.1  , то можно прочитать и дату этого события - "4 Июнь 2010".
А это вот сообщение, о том, что VBA в OOo работает, опубликовано в январе прошлого года...
Намёк ясен?

[apt31]

Намек ясен, но ссылку на сообщение "о том, что VBA в OOo работает"  не нашел. И потом,  открываю файл с макросами VBA в OpenOffice.org 3.2.1 , и выдает сообщение
"Ошибка метод  Range("E64500:A5").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A2:A3"), Unique:=False, copytorange:=Range("N6")  не найден. И так на любом макросе
Может я что то не понимаю но как OOo  может найти метод которого в нем нет генетически.