libreoffice calc basic combobox как сделать выпадающий список из ячейки

Автор Lukich, 14 декабря 2022, 15:24

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

Lukich

Нужно выпадающий список из ячейки А1 в combobox, при этом кнопкой добавить виденный новый текст сместить ячейку с текстом вниз.

economist

Без макросов, на Данные - Проверка - Диапазон - Справочник (имя диапазона)
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...

Lukich

#2
С макросом в диалоге, без макроса знаю как, а диалоге и через васик не как не могу уже всё пробовал, не могу сделать чтобы из диапазона ячеек выпадал список и можно было вводить новый текст, а кнопкой добавить в ячейку.

sokol92

Если я правильно понял задание.  :)
Форму диалога не менял.

Для вызова диалога выполните макрос ShowDialog.

Option Explicit

' Показывает диалог.
Sub ShowDialog
  Dim oDialog, oRange, oCur, arr1, arr2() As String, i As Long
  oDialog=CreateUnoDialog(ThisComponent.DialogLibraries.getByName("Standard").getByName("Dialog1"))
 
  oRange=ThisComponent.Sheets(0).getCellRangeByName("A1")
  oCur=oRange.getSpreadSheet.createCursorByRange(oRange)
  oCur.collapseToCurrentRegion
 
  ' Переносим данные из диапазона в массив
  arr1=oCur.DataArray
  ReDim arr2(Ubound(arr1))
  For i=0 To  Ubound(arr1)
    arr2(i)=arr1(i)(0)
  Next i 
 
  oDialog.getControl("ComboBox1").getModel().StringItemList=arr2
  oDialog.execute
End Sub

' При нажатии на кнопку "Добавить" диалога дополняет список и переносит в диапазон ячеек.
Sub AddButtonHandler(oEvent)
  Dim oDialog, oControl, oSheet, s As String, arr1, arr2, i As Long
  oDialog=oEvent.Source.Context
  oControl=oDialog.getControl("ComboBox1")
  s=oControl.Model.Text
  If s<>"" Then  ' добавляем в список
    oControl.addItem s, 0
   
    ' Переносим данные из списка в диапазон
    arr2=oControl.Model.StringItemList
    ReDim arr1(Ubound(arr2))
    For i=0 To  Ubound(arr2)
      arr1(i)= Array(arr2(i))
    Next i 
   
    ThisComponent.Sheets(0).getCellRangeByPosition(0,0,0,Ubound(arr2)).setDataArray arr1
  End If   
End Sub

Владимир.

eeigor

#4
Цитата: Lukich от 14 декабря 2022, 15:24Нужно выпадающий список из ячейки А1...
Так ведь из ячейки A1. Или из диалога? Опять-таки зачем всё это нужно, даже помыслить боюсь...
Цитата: Lukich от 15 декабря 2022, 10:05...а диалоге и через васик...
Это про кого? А, BASIC.

Ну, вроде, Владимир сделал, что просили. Но смысл сделанного мне остался неясен. Достаточно Alt+Arrow Down, и добавляй себе, что хочешь. Или вся соль в смещении диапазона через вставку строки?
Измените структуру листа (добавьте столбец слева), и вся работа макроса будет нарушена. Или удалите текст в ячейке диапазона где-нибудь по-серёдке ("Элемент5") - и конец.
OP должен учитывать, что в предложенном макросе (который дает направление для самостоятельной работы), несмотря на его размеры, решается несколько задач (три). В идеале - ОДНА (зд. ShowDialog). Получение ссылки на диапазон через курсор и конверсия массива - это самостоятельные задачи. И у нас давно есть для этого отдельные функции более универсального назначения. Ну, дело вкуса и стиля программирования...

P.S. Вообще, есть просьба к авторам помечать свои темки тэгом типа #учебныйвопрос. Чтобы мы не искали в этом практическую целесообразность. А действовали по принципу "тупо-глупо". Заранее приношу свои извинения

Function GetCurrentRegion(oRange As Object) As Object  '-> ScCellCursorObj
Dim oCursor As Object
oCursor = oRange.Spreadsheet.createCursorByRange(oRange)
' Expand the cursor into the region containing the cells to which
' it currently points. A region is a cell range bounded by empty cells.
oCursor.collapseToCurrentRegion()
GetCurrentRegion = oCursor  'oRange.Spreadsheet.getCellRangeByName(oCursor.AbsoluteName)
End Function

Function DataArrayTo1D(aIn)
''' Convert 1D cell range data array (array of arrays) to 1D array.
'''
''' Argument:
''' aIn:
''' 1D array of arrays (one row/column).
''' Returns: 1D array (vector).
''' If the input data array is not a vector,
''' execution will terminate and the input array is returned.
'''
On Local Error GoTo HandleErrors
Dim aOut, c&, r&, bByRow As Boolean

If UBound(aIn) > 0 And UBound(aIn(0)) > 0 Then
MsgBox "Data array is not one row or one column (not a vector)." _
, MB_ICONEXCLAMATION, "Error in DataArrayTo1D"
DataArrayTo1D = aIn
Exit Function
End If
bByRow = (UBound(aIn) = 0)  'And UBound(aIn(0)) >= 0

If bByRow Then
ReDim aOut(UBound(aIn(0)))  'number of columns (upper bound of nested array)
Else
ReDim aOut(UBound(aIn))  'row count
End If

' NOTE: Dimension 1 is used by default and omitted.
For r = LBound(aIn) To UBound(aIn)
For c = LBound(aIn(r)) To UBound(aIn(r))
If bByRow Then
aOut(c) = aIn(r)(c)
Else
aOut(r) = aIn(r)(c)
End If
Next c
Next r

DataArrayTo1D = aOut
Exit Function

HandleErrors:
MsgBox Error, MB_ICONEXCLAMATION _
, "Error " & Err & " at line " & Erl & " in DataArrayTo1D()"
End Function


UPD. https://forum.openoffice.org/en/forum/viewtopic.php?p=498258#p498258
Неплохо сказал @Villeroy. Я бы так не смог... Хотя мою мысль передал верно  :(
ИМХО, пользователю нужно помогать, а не потакать...
Ubuntu 18.04 LTS • LibreOffice 7.5.1.2 Community

Lukich

Цитата: sokol92 от 15 декабря 2022, 16:44Если я правильно понял задание.  :)
Форму диалога не менял.

Для вызова диалога выполните макрос ShowDialog.

Option Explicit

' Показывает диалог.
Sub ShowDialog
  Dim oDialog, oRange, oCur, arr1, arr2() As String, i As Long
  oDialog=CreateUnoDialog(ThisComponent.DialogLibraries.getByName("Standard").getByName("Dialog1"))
 
  oRange=ThisComponent.Sheets(0).getCellRangeByName("A1")
  oCur=oRange.getSpreadSheet.createCursorByRange(oRange)
  oCur.collapseToCurrentRegion
 
  ' Переносим данные из диапазона в массив
  arr1=oCur.DataArray
  ReDim arr2(Ubound(arr1))
  For i=0 To  Ubound(arr1)
    arr2(i)=arr1(i)(0)
  Next i 
 
  oDialog.getControl("ComboBox1").getModel().StringItemList=arr2
  oDialog.execute
End Sub

' При нажатии на кнопку "Добавить" диалога дополняет список и переносит в диапазон ячеек.
Sub AddButtonHandler(oEvent)
  Dim oDialog, oControl, oSheet, s As String, arr1, arr2, i As Long
  oDialog=oEvent.Source.Context
  oControl=oDialog.getControl("ComboBox1")
  s=oControl.Model.Text
  If s<>"" Then  ' добавляем в список
    oControl.addItem s, 0
   
    ' Переносим данные из списка в диапазон
    arr2=oControl.Model.StringItemList
    ReDim arr1(Ubound(arr2))
    For i=0 To  Ubound(arr2)
      arr1(i)= Array(arr2(i))
    Next i 
   
    ThisComponent.Sheets(0).getCellRangeByPosition(0,0,0,Ubound(arr2)).setDataArray arr1
  End If   
End Sub


Спасибо большое, я бы не додумался, в икселе как-то проще было сделать тоже самое.

eeigor

Цитата: sokol92 от 15 декабря 2022, 16:44 
    ' Переносим данные из списка в диапазон
    arr2=oControl.Model.StringItemList
    ReDim arr1(Ubound(arr2))
    For i=0 To  Ubound(arr2)
      arr1(i)= Array(arr2(i))
    Next i 
   
    ThisComponent.Sheets(0).getCellRangeByPosition(0,0,0,Ubound(arr2)).setDataArray arr1
Или так...
    ' Переносим данные из списка в диапазон.
    items = oControl.Model.StringItemList
    fa = createUnoService("com.sun.star.sheet.FunctionAccess") 
    data = fa.callFunction("TRANSPOSE", Array(Array(items)))
    ThisComponent.Sheets(0).getCellRangeByPosition(0, 0, 0, UBound(items)).DataArray = data
Ubuntu 18.04 LTS • LibreOffice 7.5.1.2 Community

sokol92

#7
Цитата: eeigor от 16 декабря 2022, 11:40Или так
Как нас учили классики - практика критерий истины.
Кстати, в Excel функция рабочего листа TRANSPOSE давно уже скомпрометирована.
Sub Test1
  Dim t As Long, arr(10000) As String, arr2, i As Long
   For i=0 To Ubound(arr)
    arr(i)="a" & i
  Next i 
 
  t=getSystemTicks()
  ReDim arr2(Ubound(arr))
  For i=0 To Ubound(arr)
    arr2(i)=Array(arr(i))
  Next i 
  Msgbox getSystemTicks() - t
End Sub

Sub Test2
  Dim t As Long, arr(10000) As String, arr2, i As Long, fa
  For i=0 To Ubound(arr)
    arr(i)="a" & i
  Next i 
 
  fa=createUnoService("com.sun.star.sheet.FunctionAccess")
  t=getSystemTicks()
  arr2 = fa.callFunction("TRANSPOSE", Array(Array(arr)))
  Msgbox getSystemTicks() - t
End Sub
У меня время работы второго макроса в 1,8 раза больше первого.

Ситуация ухудшается, если мы увеличим размерность массива. Выясняется, что TRANSPOSE не работает (ошибка времени выполнения), если массив содержит более 16384 элемента. Какое-то родовое проклятие.  :)

В документации указанное ограничение функции не нашел. О баге сообщу.
Владимир.


mikekaganski

#9
Вряд ли это можно назвать багом и исправить.
ScFunctionAccess::callFunction фактически создаёт временный лист, заполняет его Вашими данными, а затем выполняет формулу. Ну и при заполнении, естественно, можно внести только столько столбцов, сколько позволяет лист (и теперь это уже не 1024, а в 16 раз больше).

Но хорошо, что баг такой написан.
С уважением,
Михаил Каганский

kompilainenn

Цитата: sokol92 от 16 декабря 2022, 13:45Выясняется, что TRANSPOSE не работает (ошибка времени выполнения), если массив содержит более 16384 элемента
Оно же так и должно быть, разве нет? У нас сейчас 16384 столбца и есть по дефолту, как должны транспонироваться бОльшие количества?
Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут

sokol92

Цитата: kompilainenn от 16 декабря 2022, 16:28Оно же так и должно быть, разве нет?
У меня рудименты мышления пользователя Excel.  :)
В Excel функции рабочего листа "обслуживают" формулы, но вместе с тем, могут использоваться как "независимый" калькулятор. При этом ограничения рабочего листа Excel не действуют.
Попробуем в Excel эмулировать сумму 5 000 000 строк (VBA):
Sub test2()
  Dim arr(1 To 5000000, 1 To 1), v
  arr(1, 1) = 1
  arr(5000000, 1) = 2
  Debug.Print Application.WorksheetFunction.Sum(arr)
End Sub

Выводит 3.
Владимир.

eeigor

А ведь я не впервой заворачиваю тему в дебри. Приятно, что и там есть живые души :)
Ubuntu 18.04 LTS • LibreOffice 7.5.1.2 Community