Собрать данные из файлов ODS

[Miroslavovna]

ПОМОГИТЕ!!! Система Astra, офис LiBREoffice. Собрать в файл протокол данные из Иванова и Петрова (файлы из одной папки). непонятно: почему не берется следующий файл. макрос в протоколе описан:

Sub prot
  Dim file_dialog, Protokol, List  as Object
  Dim status as Integer
  Dim init_path as String
  Dim ucb as object
  Dim filterNames(3) as String
  Dim k As Long   
  Protokol =ThisComponent
  sURLFolder=replace(Protokol.url,Protokol.title,"")
  List = Protokol.sheets(1)
  k=9
  filterNames(0) = "*.*"
  GlobalScope.BasicLibraries.LoadLibrary("Tools")
  file_dialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
  ucb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  AddFiltersToDialog(FilterNames(), file_dialog)
  'Set your initial path here!
  init_path = ConvertToUrl("/usr") 
  file_dialog.setMultiSelectionMode(True)
  If ucb.Exists(init_path) Then
      file_dialog.SetDisplayDirectory(init_path)
  End If
  status = file_dialog.Execute()
  If status = 1 Then
      file_path = file_dialog.getSelectedFiles()
      open_files = file_path   
  Dim oSFA As Object, aFiles, file, afile As String, i,n As Long, arr, sep As String
  oSFA=createUnoService("com.sun.star.ucb.SimpleFileAccess")
  sep=GetPathSeparator()
  For i=0 To Ubound(open_files)
  file=open_files(i)
  '  file=ConvertFromUrl(open_files(i))
    If Right(LCase(file), 4)=".ods" Then
      ' sep=GetPathSeparator()
      ' arr=Split(file, sep)
      Dim FileProperties(0) As New com.sun.star.beans.PropertyValue

FileProperties(0).Name = "Hidden"
FileProperties(0).Value = False

oAdoc = StarDesktop.loadComponentFromURL(file, "_blank", 0, FileProperties())

Stat=oAdoc.Sheets(0).getCellRangeByName("C6").string'source
FIO=oAdoc.Sheets(0).getCellRangeByName("C7").string 'source
Div=oAdoc.Sheets(0).getCellRangeByName("C8").string 'source
Org=oAdoc.sheets(0).getCellRangeByName("C9").string 'source
STRuc=oAdoc.sheets(0).getCellRangeByName("C10").string 'source
DOLG=oAdoc.sheets(0).getCellRangeByName("C11").string 'source
DATA_DOLG=oAdoc.sheets(0).getCellbyPosition(2,11).string  'source можно через индекс
DATA_ROGD=oAdoc.sheets(0).getCellRangeByName("C13").string 'source
Vozrast = DateDiff("yyyy", DATA_ROGD, Date)
KPE=oAdoc.sheets(0).getCellRangeByName("A23").string 'source
PTZN=oAdoc.sheets(0).getCellRangeByName("Z33").string 'source

'эoPlan=oAdoc.sheets.getbyname("ИПР2024").getCellRangeByName("с6"+"с7"+"с8") 'source
'Plan=oPlan.getDataArray()
'oReal=oAdoc.sheets.getbyname("ИПР2024").getCellRangeByName("с6"+"с7"+"с8") 'source
'Real=oReal.getDataArray()

  oAdoc.Close true
  'oAdoc.Delete

List.getCellByPosition(3,k-1).string =FIO 'target
List.getCellByPosition(4,k-1).string = Vozrast 'target
List.getCellByPosition(5,k-1).string =DOLG 'target
List.getCellByPosition(6,k-1).string  = DATA_DOLG 'target
List.getCellByPosition(7,k-1).string  = Div 'target
List.getCellByPosition(8,k-1).string = STRuc 'target

'      CopyFile file
      n=n+1
      k=K+1
    End If
  Next i
  Msgbox "Обработано файлов: " & n 
  End If
  file_dialog.Dispose() 
End Sub

[sokol92]

Перенесите строку

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

Dim FileProperties(0) As New com.sun.star.beans.PropertyValue
в начало макроса.

[Miroslavovna]

есть шаблонная строка как перенести в следующую строку протокола
oArange = List0.getCellRangeByName("J1:AW10") 'source
oAarray=oArange.getDataArray()
'oCrange = createUnoService("com.sun.star.frame.DispatchHelper")
oCrange = List.getCellRangeByName("A10:AW10") 'target
oCraray = oCrange.setDataArray()
oCraray = oAarray

[sokol92]

Уточните, пожалуйста, вопрос. У Вас диапазоны ячеек разного размера: J1:AW10 и A10:AW10 ?