[Решено] Calc: Как лучше перебрать все пустые ячейки в нескольких диапазонах?

[eeigor]

Пустые ячейки были выделены с использованием метода queryEmptyCells(). Возвращён объект ScCellRangesObj (несколько диапазонов). Необходимо ввести формулу в указанные ячейки. Пример не работает.

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

    oEnum = ThisComponent.CurrentSelection.Cells.CreateEnumeration
   Do While oEnum.hasMoreElements
       oCell = oEnum.NextElement
       oCell.Formula = "=A1"  'inserts some formula
   Loop
Метод CreateEnumeration игнорирует пустые ячейки (). В цикл выше даже не удается войти. Что, создавать три цикла "For - Next" для обхода всех выделенных пустых ячеек в диапазонах, строках, столбцах? Быстрее никак? Во все ячейки надо ввести одинаковую формулу с относительной адресацией. Формула массива не подойдёт. Ячейки надо перебрать по одной. Или как?

[sokol92]

Вот так должно работать без цикла по ячейкам.

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

' Присваивает формулу ячейкам прямоугольного диапазона
Sub RangePutFormula(oRange, formula)
  oRange.getCellByPosition(0,0).Formula=formula
  oRange.fillAuto(0,1)
  oRange.fillAuto(1,1)
End Sub

' Присваивает формулу ячейкам нескольких прямоугольных диапазонов
Sub RangesPutFormula(oRanges, formula)
  Dim oRange
  For Each oRange In oRanges
    RangePutFormula oRange, formula
  Next oRange 
End Sub

' Проверка для выделенных ячеек
Sub TestPutFormula
  Dim oRanges, formula
  formula="=2+3"
  oRanges = ThisComponent.CurrentSelection
 
  If HasUnoInterfaces(oRanges, "com.sun.star.sheet.XSheetCellRanges") Then
    RangesPutFormula oRanges, formula
  Else
    RangePutFormula oRanges, formula
  End If     
End Sub

[eeigor]

@sokol92, спасибо за дельный ответ. Второй ответ пришёл практически одновременно с другого форума. Но оба решения похожи. Я позволил себе привести ваш вариант со ссылкой на автора. Возможно, Вам будет интересно увидеть другой вариант решения.

UPD: Это, конечно, не здорово, что нельзя перебрать ячейки, как мне хотелось бы. Я даже могу предположить, зачем так сделано. Ведь, если я выделяю столбец/строку, то метод queryEmptyCells() возвращает все пустые ячейки в столбце/строке со всего листа, и я обрезаю этот результат по границам UsedRange (Excel так бы и сделал без моей помощи методом SpecialCells), но Calc не делает, зато "идёт дальше" и вторгается в границы используемого диапазона. Отсюда и появляется эта проблема. Но трудно представить случай, когда хаотично выбранные пустые ячейки надо заполнять индивидуальным образом, поэтому здесь единая относительная формула с вашим подходом решает поставленную задачу.

[sokol92]

другой вариант решения.

Спасибо за ссылку. Я стараюсь использовать методы Диспетчера только в случаях, когда нет (или плохо искал) аналогичных методов UNO. К примеру, специальная вставка ячеек или копирование (одной операцией) группы листов из одного документа Calc в другой.

[eeigor]

Оказывается, есть ещё одно решение в виде надстройки. При переходе по ссылке загрузка начнётся автоматически. Не тестировал.

[eeigor]

Вот так должно работать без цикла по ячейкам.

Работает превосходно.
Надо привести и формулу для заполнения пустой ячейки значением из вышележащей ячейки:
formula = "=INDIRECT(ADDRESS(ROW()-1;COLUMN();4))"

[economist]

=OFFSET проще, одна функция вместо двух, хоть и тоже "беспокойная", т.е. волатильная

[sokol92]

Добрый день! Как и в Excel, не стоит использовать функции, если можно обойтись более простыми конструкциями.
Приведенная ниже функция RangePutFormula заносит формулу в ячейки дипазона(ов). Формулу можно задавать в синтаксисах Calc, Excel A1 и Excel R1C1 (последний стиль подходит для данной задачи, см. макрос Test ниже).

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

Option Explicit

' Присваивает формулу ячейкам диапазона (диапазонов)
' Параметры:
' oDoc     документ Calc
' oRange   диапазон(ы) ячееек
' Formula  формула (первый знак должен быть "=")
' Syntax   синтаксис формулы: 0-Calc; 1-Excel A1; 2-Excel R1C1
Sub RangePutFormula(Byval oDoc, Byval oRange, Byval Formula As String, Optional Byval Syntax As Long)
  Dim rangeType As Long, v
  If IsMissing(Syntax) Then
    Syntax=0
  EndIf 

  rangeType=getRangeType(oRange)
  If rangeType=1 Then      ' одна ячейка
    oRange.setFormula ConvertFormula(oDoc, oRange, Formula, Syntax)
   
  ElseIf rangeType=2 Then  ' прямоугольный диапазон         
    RangePutFormula oDoc, oRange.getCellByPosition(0,0), Formula, Syntax
    oRange.fillAuto(0,1)
    oRange.fillAuto(1,1)
   
  ElseIf rangeType=3 Then  ' несколько прямоугольных диапазонов
    For Each v In oRange
      RangePutFormula oDoc, v, Formula, Syntax
    Next v
   
  End If   
End Sub

' Определяет тип объекта oRange.
' Коды возврата:
' 1 одна ячейка
' 2 прямоугольный диапазон ячеек (число ячеек больше 1)
' 3 несколько (более 1) прямоугольных диапазонов ячеек
' 0 ни одно из вышеперечисленного 
Function getRangeType(Byval oRange) As Long
  If oRange.supportsService("com.sun.star.sheet.SheetCell") Then
    getRangeType=1
  ElseIf oRange.supportsService("com.sun.star.sheet.SheetCellRanges") Then 
    getRangeType=3
  ElseIf oRange.supportsService("com.sun.star.sheet.SheetCellRange") Then
    getRangeType=2
  Else
    getRangeType=0
  End If 
End Function

' Возвращает формулу Calc, преобразованную из одного синтаксиса в другой.
' Параметры:
' oDoc       документ Calc
' oCell      ячейка, формула для которой задается
' Formula    текст формулы
' FromSyntax синтаксис исходной формулы: 0-Calc; 1-Excel A1; 2-Excel R1C1
' ToSyntax   синтаксис целевой формулы (значения как у FromSyntax)
Function ConvertFormula(Byval oDoc, Byval oCell, Byval Formula As String, Byval FromSyntax As Long, Optional ByVal ToSyntax As Long) As String
   Dim oFP, arr
   If IsMissing(ToSyntax) Then
     ToSyntax=0
   End If
   
   If FromSyntax=ToSyntax Or left(Formula, 1)<>"=" Then
     ConvertFormula=Formula
   Else 
     oFP=oDoc.createInstance("com.sun.star.sheet.FormulaParser")
     oFP.formulaConvention=FromSyntax
     arr=oFP.parseFormula(mid(Formula,2), oCell.cellAddress)
     oFP.formulaConvention=ToSyntax
     ConvertFormula="=" & oFP.printFormula(arr, oCell.cellAddress)
   End If 
End Function

' Проверка для выделенных ячеек.
' Присваиваем ссылку на предыдущую ячейку
Sub Test
  RangePutFormula ThisComponent, ThisComponent.CurrentSelection, "=R[-1]C", 2
End Sub

[eeigor]

Я недавно успел где-то столкнуться с этим парсером формул, и взял на заметку. Поэтому всё ясно. И верно.
Вопрос. А стиль R1C1 в Calc присутствует только для совместимости с Excel или нет? При отладке листа в Excel я вообще использовал только его.

[sokol92]

Вы можете изменить в Параметрах Calc / Formula синтаксис формул (первое поле). Это подействует на текущую книгу и вновь создаваемые. Синтаксис формул документа сохраняется в структуре документа. Так что, как и в Excel, можно менять синтаксис по своему усмотрению.

[eeigor]

Оффтоп.
Кто-н. знает, как вызвать команду, связанную с пунктом меню?
Конкретно, хотел бы 2 опции - "Синтаксис формулы" (стиль) и "Показать формулы" быстро переключать кнопкой на панели инструментов. В Excel такой макрос был под рукой (там несложно).
В GlobalSheetSettings их нет, а GetRegistryKeyContent() из библиотеки "Tools" - была тема - не позволяла обновить установки GlobalSheetSettings, про другие не скажу.

UPD: Работает

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

'<item oor:path="/org.openoffice.Office.Calc/Formula/Syntax"><prop oor:name="Grammar" oor:op="fuse"><value>2</value></prop></item>
' Requires: GetRegistryKeyContent()
Sub ShowGrammar()
Dim sNodePath As String

GlobalScope.BasicLibraries.LoadLibrary("Tools")
sNodePath = "org.openoffice.Office.Calc/Formula/Syntax/"
REM Xray GetRegistryKeyContent(sNodePath)
MsgBox "Property Value:  " _
& GetRegistryKeyContent(sNodePath).getByName("Grammar") _
, MB_ICONINFORMATION, "Syntax • Grammar"
End Sub

Sub SetGrammar()
Dim oRegKey As Object
Dim sNodePath As String

sNodePath = "/org.openoffice.Office.Calc/Formula/Syntax"
oRegKey = GetRegistryKeyContent(sNodePath, True)
oRegKey.setPropertyValue("Grammar", 2)  '<< 0=Calc A1; 1=Excel A1; 2=Excel R1C1
oRegKey.commitChanges()
End Sub

'    From "Tools" Library
Function GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean)
Dim oConfigProvider as Object
Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider")
aNodePath(0).Name = "nodepath"
aNodePath(0).Value = sKeyName
If IsMissing(bForUpdate) Then
GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath())
Else
If bForUpdate Then
GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aNodePath())
Else
GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath())
End If
End If
End Function

Вот, кажется всё и получилось. Только добавьте значение параметра в аргументы процедуры SetGrammar. Имя можно уточнить: SetFormulaSyntax(nSetting).

[rami]

"Показать формулы" есть в "Сервис" —> "Настройка..."

[eeigor]

rami, спасибо. Добавил на панель.
В ответе #10 получился неплохой пример работы с реестром. Всё работает. Не в тему, но... удачно  
А со вторым свойством то же самое не работает.
Ключ
<item oor:path="/org.openoffice.Office.Calc/Content/Display"><prop oor:name="Formula" oor:op="fuse"><value>true</value></prop></item>

Не работает даже так: enableasync:=False; oConfig.flush()

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

Sub ShowFormula2()
Dim oConfig As Object, oRegKey As Object
Dim aProps(1) As New com.sun.star.beans.PropertyValue

aProps(0).Name  = "nodepath"
aProps(0).Value = "/org.openoffice.Office.Calc/Content/Display"
' If false, the cache must operate in write-through mode, where updates are written
       ' to persistent storage at once - that is before ::com::sun::star::util::XChangesBatch::commitChanges() returns.
aProps(1).Name  = "enableasync"
aProps(1).Value = False

oConfig = createUnoService( "com.sun.star.configuration.ConfigurationProvider" )
' Xray oConfig
oRegKey = oConfig.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aProps())
' Xray regkey
oRegKey.setPropertyValue("Formula", True)
oRegKey.commitChanges()

oConfig.flush()
End Sub

[eeigor]

Нет, макрос выше работает, но LO не обновляет настройки.
Однако делать это «умеет» по нажатию на кнопку меню.
Bug вроде этого.
Подобное решение.

[rami]

"Показать формулы":

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

Sub Main
ThisComponent.CurrentController.ShowFormulas = True
End Sub