Добрый день! Пожалуйста помогите переделать из VBA в OpenO...

[ForumOOo (бот)]

Компонент: Calc
Версия продукта: 4.1.x
Сборка: Apache OpenOffice
ОС: windows 7

Добрый день!
Пожалуйста помогите переделать из VBA в OpenOffice
Dim city As Variant
Dim shop(20) As Variant

Private Sub UserForm_Initialize()
    city = Array("Берлин", "Токио", "Вена")
    shop(0) = Array("Книги", "Снаряжение", "Туризм", "Продукты")
    shop(1) = Array("Авто", "Бриз", "Камни")
    shop(2) = Array("Сплав", "Тропа", "Ветер странствий", "Яхонт")

    ListBox1.List = city
    ListBox1.ListIndex = 0
    End Sub
Private Sub ListBox1_Click()
ListBox2.Clear
ListBox2.List = shop(ListBox1.ListIndex)
End Sub
Спасибо!

--
Подпись: recoon
Эл. почта: ts58eu@mail.ru

[rami]

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

[Pavv]

Все добрый день.
Эх, не было проблем, но решили контору переводить на бесплатный софт. В связи с этим возникли проблемы. Есть в excel некоторое количество макросов. Их нужно перенести на LibreOffice Calc.
Версия LibreOffice: 4.3.3.2
ID сборки: 9bb7eadab57b6755b1265afa86e04bf45fbfc644
скачана с оф сайта.

На VBA  в Excel имеем вот такой макрос:

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


Sub SelectionCalculate2УбираетЗнакРавно()

    Dim Str, sss As String
    Dim N As Variant
       
    Set ss = Selection
    For Each cl In Selection.Cells   'действия проводим с каждой выделенной ячейкой, они могут быть выделены в разных местах листа.
                                                ' начальное условие - в ВСЕХ ячейках имеется формула   =375*(1+Пересчет!R11C9/100)
        cl.Select
        Application.CutCopyMode = False
        Str = ActiveCell.FormulaR1C1   ' записываем содержание выделенной ячейки в переменную STR
        Str = Trim(Str)                        ' убираем всяческие пробелы
        If (Str <> "") Then   'на всякий случай проверяем если ячейка НЕ пустая
          If (Str <> "-") Then  'проверяем если ячейка НЕ равна "минусу", просто иногда попадаются такие ячейки
                If (Mid(Str, 1, 3) <> "=CE") Then ' проверяем если первые три символа не равно "=СЕ", т.е. в ячейке нет формулы =СEILING(...
                    Str = Right(Str, Len(Str) - 1) ' удаляем знак =
                    ActiveCell.FormulaR1C1 = "=CEILING((" & Str & "),50)"  ' и применяем к выделенной ячейке формулу округления
                End If
          End If
        End If
    Next cl
    ss.Select
End Sub


Был бы благодарен за помощь. Своими силами что то не получается.

[rami]

Давайте уточним:
1. вы используете синтайсис формул Excel R1C1
2. на листе есть два вида формул: =375*(1+Пересчет!R11C9/100), которую нужно воткнуть во внутрь СEILING()  и =СEILING(..., которую изменять нельзя. Есть ли на листе другие формулы?
3. какая у вас локаль?

[Pavv]

Давайте уточним:
1. вы используете синтайсис формул Excel R1C1
2. на листе есть два вида формул: =375*(1+Пересчет!R11C9/100), которую нужно воткнуть во внутрь СEILING()  и =СEILING(..., которую изменять нельзя. Есть ли на листе другие формулы?
3. какая у вас локаль?

1. Синтаксис можно любой использовать. Это не критично. Значение ячейки R11C9 - постоянное и всегда в этой ячейке.
2. не совсем понял что хотите спросить. См. файл экселевский.
3. Версия LibreOffice: 4.3.3.2 Windows 7 x32

Поставщик присылает файлы в таком формате.  Задача сохранив в ячейке формулу =375*(1+Пересчет!R11C9/100) сделать округление до кратного 50., т.е. чтобы получилось в ячейке =ОКРВВЕРХ(375*(1+Пересчет!R11C9/100);50)
Такое нужно проделать со всеми выделенными ячейками.

[Pavv]

Понял вопрос из второй позиции.
Да на случай если какая то ячейка уже была округлена, и по случайности ее выделил (т.к. прайс лист бывает длинный и сразу все не выделить), чтобы эту ячейку пропускал макрос.

[Pavv]

Пробую тупо выполнить VBA макрос в Libre он выполняется но в формулу от куда то добавляет три лишние скобки в конце

[RAN]

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

Sub SelectionCalculate2УбираетЗнакРавно()
   Dim cl As Range
   On Error Resume Next
   For Each cl In Selection.Cells   'действия проводим с каждой выделенной ячейкой, они могут быть выделены в разных местах листа.
       ' начальное условие - в ВСЕХ ячейках имеется формула   =375*(1+Пересчет!R11C9/100)
       If cl.HasFormula Then
           If InStr(cl.Formula, "CEILING") = 0 Then
               cl.Formula = "=CEILING(" & Mid(cl.Formula, 2) & ";50;1)"    ' и применяем к выделенной ячейке формулу округления
               If Err Then
                   Err.Clear
                   cl.Formula = "=CEILING(" & Mid(cl.Formula, 2) & ",50)"
               End If
           End If
       End If
   Next
End Sub

Работает и в Excel, и в Либре
Для либре добавить

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

Option VBASupport 1

[JohnSUN]

Чего-то у тебя разделитель параметров в формуле то "точка с запятой", то просто "запятая"... Неаккуратненько как-то... 

[RAN]

Будет аккуратно - не будет работать. 

[Pavv]

RAN, в либре если выделить несколько ячеек (зажав Ctrl) - формула применяется только к одной.

Скачал на этом форуме макрос немного другой. И подправил почти под себя. Вроде все работает. Вопрос только как его изменить чтобы он работал в выделенными ячейками, а не с конкретным диапазоном.

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


sub stolbec
dim oShDoc as object ' Объявление объектной переменной всего табличного документа
dim oSheet as object ' Объявление объектной переменной листа табличного документа
dim oCell as object ' Объявление объектной переменной ячейки листа табличного документа
dim ValuA(12) as string  ' Объявление исходного массива со значениями определённых ячеек листа табличного документа
dim ValuB(12) as string  ' Объявление обработаннного массива, полученного из ValuA() путём неких преобразований
dim i as integer
oShDoc=thiscomponent
oSheet=oShDoc.sheets(0) ' Получение модели листа по его номеру (нумерация с 0)
'oSheet=oShDoc.sheets.getbyname("Лист1") ' Получение модели листа по его имени
for i=0 to 12
oCell=oSheet.getcellbyposition(0,i) ' Получение модели ячейки по её позиции (первое значение метода - номер столбца, второе - строки;)
' нумерация ячеек начинается с 0,0, что соответствует A1
ValuA(i)=oCell.string ' Запись значения ячейки в массив
ValuB(i)="=CEILING(" & ValuA(i) & ";50)"' Некоторые преобразования
oCell=oSheet.getcellbyposition(1,i)
oCell.formula=ValuB(i) ' Передача значений в соседний столбец
next
end sub


[Pavv]

Поправочка - если ячейки выделены соседние - то все работает,  а если выделяю ячейки в разных местах (не соседние) , то формула применяется только к первой выделенной.

[RAN]

Если выделить несколько несвязанных диапазонов (через Ctrl), он и в Excel сработает только для первой. как и ваш код, кстати.
Для несвязанных диапазонов

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

Sub SelectionCalculate2УбираетЗнакРавно_areas()
    Dim cl As Range, ar As Range
    On Error Resume Next
    For Each ar In Selection.Areas
        For Each cl In ar.Cells   'действия проводим с каждой выделенной ячейкой, они могут быть выделены в разных местах листа.
            ' начальное условие - в ВСЕХ ячейках имеется формула   =375*(1+Пересчет!R11C9/100)
            If cl.HasFormula Then
                If InStr(cl.Formula, "CEILING") = 0 Then
                    cl.Formula = "=CEILING(" & Mid(cl.Formula, 2) & ";50;1)"    ' и применяем к выделенной ячейке формулу округления
                    If Err Then
                        Err.Clear
                        cl.Formula = "=CEILING(" & Mid(cl.Formula, 2) & ",50)"
                    End If
                End If
            End If
        Next
    Next
End Sub

[Pavv]

Отлично, сейчас работает. Спасибо. Но на родом либровском тоже было бы интересно это сделать. Буду пробовать, а пока буду пользоваться вашим скриптом.

[JohnSUN]

А можно спросить? А уже существующие округления - они что, дороги как память?
Просто если их - эти CEILING'и - никогда не пишут от руки (с ошибками или другими параметрами), а всегда создают этим же макросом, то наклёвывается немного другой алгоритм: вылить воду, выключить газ и свести задачу к предыдущей. Я имею в виду, что поиск/замена с включенными регулярными выражениями
Что искать - (=)(CEILING\()(.+)(\$Пересчет)(.+)(;50;1\))
На что менять - $1$3$4$5
легко и быстро оставит все формулы с упоминанием листа Пересчет без округляющих обёрток.
А следующий поиск-замена
Что искать - (=)(.+)(\$Пересчет)(.+)
На что менять - =CEILING($2$3$4;50;1)
моментально округлит все формулы ссылающиеся на Пересчет.
При этом не придётся предварительно вручную выделять обрабатываемые ячейки... Нет, может я, конечно, не понял о чём речь, но в таком виде макрос становится проще и лаконичнее...