Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

26 Март 2019, 13:32 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Часто задаваемые вопросы по LibreOffice и Apache OpenOffice.org
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1 2 3 »   Вниз
  Печать  
Автор Тема: Добрый день! Пожалуйста помогите переделать из VBA в OpenO...  (Прочитано 9134 раз)
0 Пользователей и 1 Гость смотрят эту тему.
ForumOOo (бот)

Offline Offline

Сообщений: 678


« Стартовое сообщение: 9 Октябрь 2014, 13:35 »

Компонент: 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
Гуру
*******
Offline Offline

Пол: Мужской
Сообщений: 2 662


MacBook Pro, LibreOffice и Apache OpenOffice


« Ответ #1: 9 Октябрь 2014, 15:17 »

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

* Два списка.ods (12.74 Кб - загружено 18 раз.)
Записан

Pavv
Участник
**
Offline Offline

Сообщений: 16


« Ответ #2: 14 Ноябрь 2014, 19:04 »

Все добрый день.
Эх, не было проблем, но решили контору переводить на бесплатный софт. В связи с этим возникли проблемы. Есть в 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
Гуру
*******
Offline Offline

Пол: Мужской
Сообщений: 2 662


MacBook Pro, LibreOffice и Apache OpenOffice


« Ответ #3: 15 Ноябрь 2014, 00:41 »

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

Pavv
Участник
**
Offline Offline

Сообщений: 16


« Ответ #4: 15 Ноябрь 2014, 11:49 »

Давайте уточним:
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)
Такое нужно проделать со всеми выделенными ячейками.

* price_excel.xls (56.5 Кб - загружено 10 раз.)
« Последнее редактирование: 15 Ноябрь 2014, 11:52 от Pavv » Записан
Pavv
Участник
**
Offline Offline

Сообщений: 16


« Ответ #5: 15 Ноябрь 2014, 11:55 »

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

Сообщений: 16


« Ответ #6: 15 Ноябрь 2014, 12:58 »

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


* 01.png (15.41 Кб, 472x372 - просмотрено 26 раз.)

* 02.png (42.63 Кб, 776x431 - просмотрено 25 раз.)
« Последнее редактирование: 15 Ноябрь 2014, 13:14 от Pavv » Записан
RAN
Участник
**
Offline Offline

Расположение: Н. Новгород
Сообщений: 40

Мяв? Мяв!


« Ответ #7: 15 Ноябрь 2014, 13:16 »

Код:
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
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

Пол: Мужской
Расположение: Киев
Сообщений: 2 747


Помогаю людям и компьютерам понимать друг друга


WWW
« Ответ #8: 15 Ноябрь 2014, 13:23 »

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

Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне
RAN
Участник
**
Offline Offline

Расположение: Н. Новгород
Сообщений: 40

Мяв? Мяв!


« Ответ #9: 15 Ноябрь 2014, 13:29 »

Будет аккуратно - не будет работать.  Смеющийся
Записан
Pavv
Участник
**
Offline Offline

Сообщений: 16


« Ответ #10: 15 Ноябрь 2014, 13:30 »

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
Участник
**
Offline Offline

Сообщений: 16


« Ответ #11: 15 Ноябрь 2014, 13:36 »

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


* 03.png (6.83 Кб, 617x296 - просмотрено 19 раз.)
Записан
RAN
Участник
**
Offline Offline

Расположение: Н. Новгород
Сообщений: 40

Мяв? Мяв!


« Ответ #12: 15 Ноябрь 2014, 13:40 »

Если выделить несколько несвязанных диапазонов (через 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
Участник
**
Offline Offline

Сообщений: 16


« Ответ #13: 15 Ноябрь 2014, 13:45 »

Отлично, сейчас работает. Спасибо. Но на родом либровском тоже было бы интересно это сделать. Буду пробовать, а пока буду пользоваться вашим скриптом.
« Последнее редактирование: 15 Ноябрь 2014, 13:59 от Pavv » Записан
JohnSUN
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

Пол: Мужской
Расположение: Киев
Сообщений: 2 747


Помогаю людям и компьютерам понимать друг друга


WWW
« Ответ #14: 15 Ноябрь 2014, 14:01 »

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

Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне
Страниц: 1 2 3 »   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!