Переделать готовые макросы из Excel под OpenOffice

[Радистка_Кет]

Помогите пожалуйста переделать макрос Excel в макрос для OpenOffice.Calc.
Особенно интересует строчка: a = .Sheets(1).UsedRange.Val

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


Sub Test()
Dim Book As Excel.Workbook
Dim Sheet As Excel.Worksheet
Dim sFolder As String
Dim sFiles As String
Dim a(), i&, ii&, x As Byte, ILastrow&
Dim oDict As Object
Dim calc_status&
Dim n As Integer
Dim RowNo As Integer
sFolder = ThisWorkbook.Path & "\4\"
sFiles = Dir(sFolder & "*.xls")
Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = 1
With Application
calc_status = .Calculation
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
a = .Sheets(1).UsedRange.Value
For i = 5 To UBound(a)
If Len(a(i, 2)) Then
If Not oDict.exists(a(i, 2)) Then
oDict.Item(a(i, 2)) = 0&
End If
Else
Exit For
End If
Next
Do While sFiles <> ""
With GetObject(sFolder & sFiles)
a = .Sheets(1).UsedRange.Value
ReDim b(1 To UBound(a), 1 To 4)
ii = 0
For i = 5 To UBound(a)
If Len(a(i, 2)) Then
If Not oDict.exists(a(i, 2)) Then
oDict.Item(a(i, 2)) = 0&
ii = ii + 1
For x = 1 To 4: b(ii, x) = a(i, x + 1): Next
End If
Else
Exit For
End If
Next
sFiles = Dir
.Close 0
End With
If ii > 0 Then
ILastrow = Cells(Rows.Count, 5).End(xlUp).Row
Cells(ILastrow + 1, 2).Resize(ii, 4) = b
End If
Loop
.Calculation = calc_status
.ScreenUpdating = True
.EnableEvents = True

  n = 1
    For RowNo = 4 To Range("B4").SpecialCells(xlLastCell).Row - 1
     Лист1.Cells(RowNo + 1, 1) = n
      n = n + 1
    Next RowNo


End With
End Sub



Данный макрос открывает поочереди файлы и записывает -значения из них в текущую книгу, если уже есть данное значение, то пропускает

[JohnSUN]

Добро пожаловать на форум!
Если я правильно прочитал код, то первые четыре строки в текущей книге и в любой книге из подкаталога 4 - заголовки? И в обработке не участвуют?
И интересуют только значения из четырех ячеек, начиная с колонки B?
И только с первого листа?

[JohnSUN]

Ну, в общем, как-то так...

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

[Радистка_Кет]

Спасибо большое. а подскажите ещё пожалуйста, можно ли в OpenOffice запускать макрос из другой книги. в Exsel это делала таким образом:

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

Workbooks.Open ThisWorkbook.Path & "\1.xls"
Application.Run "1.xls!Module1.Test"
Workbooks("1.xls").Save
Workbooks("1.xls").Close True

и стандартные функции, такие как удаление строчки (Лист1.Rows(RegNumPos).Delete) и очистка экрана с определенной строчки, например с 3, по последнюю

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

ThisWorkbook.Sheets("Лист1").Activate
Range("A5:O65536").Select
Selection.ClearContents
ThisWorkbook.Save

[JohnSUN]

1. Можно. Один способ - просто выполнить макрос через вызов Диспетчера. Этот прием описан у Питоньяка в разделе  "5.32.2.  Run a named macro in a document". Но там есть несколько неприятных моментов: полный путь к макросу нужно задавать строкой (если кто-то переименует вызываемый файл, макрос не станет вызываться, Диспетчер его просто не найдет); сложно задавать параметры вызова; если вызываешь на выполнение функцию, то Диспетчер не вернет вычисленное значение и т.п. Другой способ - использовать метод документа ScriptProvider.getScript для получения макроса как объекта документа и выполнения метода этого объекта .invoke: тут и параметры передать легко - просто массив значений, - и результат вернуть можно. Пример функции, которая это делает здесь. Только в примере используется ThisComponent, а в твоем случае нужно вместо него подсунуть твой открытый документ с макросом.
2. Это действительно стандартные функции. Точнее, "стандартные методы" - у коллекции Rows есть метод .removeByIndex(<с какой строки>, <сколько удалять>). А для очистки содержимого - так же как и в VBA, нужно получить область листа (например, .getCellRangeByName("A5:O65536")) и выполнить её метод - будешь смеяться! - .clearContents(<что чистить>). Параметр у него - типы значений которые нужно очищать: числа, даты, строки, формулы и т.д.

[Hasim]

1. Можно.
...
Пример функции, которая это делает здесь. Только в примере используется ThisComponent, а в твоем случае нужно вместо него подсунуть твой открытый документ с макросом.

Этот пример не запускает макрос из другой книги.
Он запускает макрос из общедоступной (для любых файлов) библиотеки "Мои макросы".
Так что ThisComponent, что другой документ - это не имеет значения.

[JohnSUN]

Этот пример не запускает макрос из другой книги.
Он запускает макрос из общедоступной (для любых файлов) библиотеки "Мои макросы".
Так что ThisComponent, что другой документ - это не имеет значения.

1. Верно
2. Правильно
3. Бесспорно
Там, в примере, наглухо вписано &location=application
А если тряхнуть стариной, то можно вспомнить, что

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

Const sufix="?language=Basic&location=application" ' Окончание URI
REM Эту константу можно менять на свой вкус:
REM первая часть - language - может иметь значения Basic, Java, Python или BeanShell
REM вторая часть - location - application или document


[Радистка_Кет]

Спасибо попробую.Вот в данном примере файл из которого переносят и файл в который переносят-одинаковые по формату. А если в открываемом файле данное берутся  не из 2, а из 1 строчки, и отдельное значение в стоблце просто поставляется, одинаковое для всех?

[Радистка_Кет]

Ну в данном примере файлы были одинаковые по структуре. с 5 строчки начиналось данные, а во втором столбце уникальные значения. а теперь в папке будет лежат файл, где значения уникальные в 1 столбце, но переносим его во 2, а например 5 столбца нет, а надо просто написать что он равен, например 5.
то есть если раньше массив переносился, то нужны конкретны значения. раньше делала так:
     

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

oDict.Item(a(i, cnstNumCol)) = 0
              ii = ii + 1
              b(ii, 1) = a(i, cnstNumCol)
              b(ii, 2) = a(i, cnstNameCol)
              b(ii, 3) = 5

[JohnSUN]

О, так понятнее...
Встречный вопрос: этот нестандартный файл лежит среди пачки стандартных? Или это отдельная папка, в которой лежит пачка файлов со сдвинутыми данными?
Есть какой-то признак, по которому можно определить, что вот этот лист нужно обрабатывать особым образом?

[Радистка_Кет]

В папке все файлы всегда одинакового формата.

[JohnSUN]

Значит в подпапке \4\ файлы, которые нужно читать со второй колонки по пятую и дописывать к текущей книге, просто подставляя номер строки в первую колонку... А если читаем из подпапки \xxx\, то данные нужно брать с первой колонки сколько есть (две-три-пять ячеек), а недостающие значения заполнять чем-то заранее определенным?

[Радистка_Кет]

Да именно так, но не факт, что нам будет нужен, например 4 столбец, значения из него могут вообще не использоваться., нужны например 1, 2 и 10 столбцы

[JohnSUN]

Ну, ОТКУДА читать мы задаем параметрами функции getDataToArray:
oSheet - объект - лист электронной книги,
nLeft - целое число от 0 до 1023 - номер первой колонки с данными (нужно читать с первой колонки - пишем 0)
nTop - целое число от 0 до миллиона с хвостиком - номер первой строки с данными (если в таблице даже заголовков нет - 0)
countCol - тоже целое число, от 1 до не понятно сколько - количество колонок с данными, которые нужно считывать для обработки

Вот ты говоришь "нужны например 1, 2 и 10 столбцы"... Значит нужно вызывать функцию так:

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

iArray = getDataToArray(iSheet, 0, 4, 10)"считать в массив данные листа iSheet, начиная с первого столбца и пятой строки, читать на ширину 10 колонок"

А насчет ПИСАТЬ - это в другом месте. Посмотри чуть ниже строчки с комментарием

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

REM Здесь можно было бы создать новый массив, в цикле перенести в него значения
Видишь? Там к массиву с данными для текущего листа добавляется новая строчка в виде массива значений. В массиве они так и идут, слева направо, через запятую... Вместо любого из них можешь написать число или текст, которые хотела бы видеть в нужной колонке.