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

Автор sergey.tsariov, 8 сентября 2011, 15:36

0 Пользователи и 1 гость просматривают эту тему.

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. Добро пожаловать на форум!
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

RFJ

#2
Вот так, например:
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
Цитата: RFJ от  8 сентября 2011, 20:41от так, например:
Спасибо работает, только как-то странно: когда забиваю формулу она срабатывает, а вот при попытке перезагрузить файл(открыть файл заново) выскакивает ошибка "ошибка времени выполнения BASIC. Переменная типа Object не установленна"

RFJ

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

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



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

Рыбка Рио

Цитата: RFJ от  9 сентября 2011, 09:17У меня ошибки не вылезают.
У меня тоже. LibO 3.4.3 + Ubuntu 11.04
Но в более ранних версиях возможно макрос пытается отработать быстрее чем открылся документ.
Строчка oSheet=oDoc.CurrentController.getActiveSheet() предполагает что документ уже открыт, видимо.
ubuntu 12.04 + LibO3.6.0

Leojse

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

JohnSUN

Конечно, возможно! Просто допиши в конце формулы
+INT(RAND())
Функция RAND() вычисляется при каждом пересчете листа, при любом его изменении. А это заставляет Calc пересчитать и формулу, в которую этот RAND() включен. А функция INT() превратит результат этой функции в ноль.
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

Leojse


Leojse

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

Hasim

Цитата: Leojse от 26 января 2013, 19:23Формат файла xls
В этом формате (xls - это из MS Office!) макросы из Open Office не сохраняются!
(Наоборот (макросы MS Office VBA в Open Office) сохраняются и работают, а вот так (макросы Open Office в MS Office) не сохраняются и не работают.)
Хотите распространять в формате XLS - пишите макросы на VBA.

Leojse


apt31

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

JohnSUN

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

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  может найти метод которого в нем нет генетически.