Set property of App 'DisplayAlerts' = 0.

REM  *****  BASIC  *****

rem ZU 2010-12-23
rem shablon OpenOffice :  "MACROS_FOR_OO_20101231_100000.ODS"
rem file with data     :  "MACROS_FOR_OO_DAT_20101231_100000.csv"
rem version of OpenOffice : 3.2.1

  Type gy_tab
    sOblast As String
    iNum    as integer
    sVar    as string
    sText   as string
  End Type

  Type gy_tab2
    sOblast       as String
    ikol_strok    as integer
  End Type
rem -----------------------------------------------------------
rem                      Main
rem -----------------------------------------------------------
Sub Main
dim DataArr2(0,0) as gy_tab
dim DataArr3(0)   as gy_tab2
dim DataArrDel(0) as string
dim sOblast_old   as string
dim i             as integer
dim j             as integer
dim i2            as integer
dim j2            as integer
dim i3            as integer
dim j3            as integer
dim i6            as integer
dim ikol_strok    as integer
dim errcode       as string

rem получим все данные
errcode = ""
readFile(DataArr2,j2,i2,errcode)

if errcode = "" Then
rem получение табл "Область-КолСтрок"
rem это для случая когда Таблиц из SAP несколько
j3 = 0
sOblast_old = ""
for j = 0 to j2
  if DataArr2(j,0).sOblast = sOblast_old Then
    DataArr3(j3-1).sOblast     = DataArr2(j,0).sOblast
    DataArr3(j3-1).ikol_strok  = DataArr3(j3-1).ikol_strok + 1
  else
    redim preserve DataArr3(0 to j3) as gy_tab2
    DataArr3(j3).sOblast     = DataArr2(j,0).sOblast
    j3 = j3 + 1
  end if
  sOblast_old = DataArr2(j,0).sOblast
next

rem создание областей
rem копирование данных
i6 = 0
sOblast_old = ""
for j = 0 to j3-1
  for i = 0 to DataArr3(j).ikol_strok
   if DataArr3(j).ikol_strok <> 0 Then
    insert_and_copy_row (DataArr3(j).sOblast,i)
    sdvig = 1
    replace_text(DataArr3(j).sOblast,DataArr2,j2,i2,i,sdvig)
    if DataArr3(j).sOblast <> sOblast_old then
     redim preserve DataArrDel(0 to i6) as string
     DataArrDel(i6) = DataArr3(j).sOblast
     i6 = i6 + 1
     sOblast_old = DataArr3(j).sOblast
    endif
   end if
   if DataArr3(j).ikol_strok = 0 Then
    sdvig = 0
    replace_text(DataArr3(j).sOblast,DataArr2,j2,i2,i,sdvig)
   end if
  next
next

rem удаление строк-шаблонов
for i = 0 to i6-1
  delete_row(DataArrDel(i))
next

rem сохранение данных
rem...
end if    rem   if errcode = ""
end sub

rem -----------------------------------------------------------
rem                      Delete_Row
rem -----------------------------------------------------------
sub Delete_Row(sOblast as string)
Dim oRangeAddress    as object
dim oSheet           as object
dim errcode          as string
dim errstr           as string
On Error Goto ErrorHandler4
oSheet         = ThisComponent.CurrentController.ActiveSheet
oRangeAddress  = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(sOblast).getRangeAddress()
oSheet.RemoveRange(oRangeAddress, com.sun.star.sheet.CellDeleteMode.UP)
Exit Sub
ErrorHandler4:
  Reset
  errcode = "OBLAST" 
  errstr  = "Область не существует" & " " & sOblast
  MsgBox errstr,0,"Error"
  Exit Sub
end sub


rem -----------------------------------------------------------
rem                      Replace_text
rem -----------------------------------------------------------
sub replace_text(sOblast as string, DataArr2() as gy_tab,j2 as integer,i2 as integer,_
                 nomer as integer, sdvig as integer)
Dim oRangeAddress    as object
Dim oRangeAddress2   as object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim oCellAddress
dim posx             as integer
dim posy             as integer
dim j5               as integer
dim i5               as integer
dim j4               as integer
dim i4               as integer
dim oCell            as object
dim errcode          as string
dim errstr           as string
On Error Goto ErrorHandler3
rem найдем стартовую позицию
oRangeAddress  = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(sOblast).getRangeAddress()
oRangeAddress2 = oRangeAddress
posx = oRangeAddress2.StartColumn
posy = oRangeAddress2.StartRow    + sdvig + nomer
rem oCellAddress = ThisComponent.CurrentController.ActiveSheet.getCellByPosition(posx, posy).getCellAddress()
rem oCell = ThisComponent.CurrentController.ActiveSheet.getCellByPosition(posx, posy)
rem надо найти область с номером Nomer
for j5 = 0 to j2
   if DataArr2(j5,0).sOblast = sOblast then
     j4 = j5 + nomer
     exit for
   end if
next
rem замена текста
for i5 = 0 to i2
  if  DataArr2(j4,i5).sOblast = sOblast Then
   posx2  = posx + i5
   posy2  = posy
   oCell  = ThisComponent.CurrentController.ActiveSheet.getCellByPosition(posx2, posy2)
   oCell_string = oCell.string 
   for i7 = 0 to i2
    sOblast2 = DataArr2(j4,i7).sOblast
    inum2    = DataArr2(j4,i7).inum
    sVar2    = DataArr2(j4,i7).sVar
    sText2   = DataArr2(j4,i7).sText
    if DataArr2(j4,i7).sOblast <> "" then
     if oCell.string = DataArr2(j4,i7).sVar Then
      oCell.string = DataArr2(j4,i7).sText
     end if
    end if
   next
  end if
next
Exit Sub
ErrorHandler3:
  Reset
  errcode = "OBLAST" 
  errstr  = "Область не существует" & " " & sOblast
  MsgBox errstr,0,"Error"
  Exit Sub
end sub

rem -----------------------------------------------------------
rem              ReadFile
rem -----------------------------------------------------------
Sub ReadFile (DataArr2() as gy_tab, glob_j as integer,glob_i as integer,errcode as string)
Dim iCount     as Integer
Dim sLine      as String
dim ilog       as Integer
dim oblast     as string
dim oblast_old as string
dim ivar       as String
dim inum       as integer
dim inum_old   as integer
dim itext      as String
Dim oSheet     as object
dim oTitle2    as string
dim lfilename  as string
rem dim errcode    as string
dim errstr     as string
dim l_pos      as integer
dim i          as integer
dim j          as integer
On Error Goto ErrorHandler2
oSheet     = ThisComponent.CurrentController.ActiveSheet
rem document   = ThisComponent.CurrentController.Frame
oTitle     = ThisComponent.Location
otime      = right(oTitle,19)
otime      = left(otime,15)
olenTitle  = len(oTitle)
oTitle2    = left(oTitle,olenTitle-19)
olenTitle2 = len(oTitle2)
oTitle2    = right(oTitle2,olenTitle2-8)
rem lfilename  = oPath + "ZWWW_DATA_" + otime + ".csv"
lfilename  = oTitle2 + "DAT_" + otime + ".csv"
l_pos = InStr(lfilename, "%")
Do While l_pos <> 0
  lfilename = ReplaceInString(lfilename, l_pos, 3, " ")
  l_pos = InStr(lfilename, "%")    
Loop
rem lfilename = "file:///C:/WINDOWS/Temp/ZSZ_OO_3Y_TOPLIVO_20101214_112155.ODS"
rem lfilename = "///tmp/ZlobinYV/ZWWW_DATA_20080225_131246.csv"
iCount = Freefile
rem errcode = "FILE"
On Error Goto ErrorHandler
open lfilename for Input as iCount
ilog = 1
i = 0
j = 0
glog_i = 0
glob_j = 0
While not eof(#iCount)
  Line Input #iCount, sLine
  select case ilog
  case 1
    oblast = sLine
    ilog = 2
  case 2
    inum = sLine
    ilog = 3 
  case 3
    ivar = sLine
    ilog = 4
  case 4
    itext = sLine
    if  oblast =  oblast_old _
    and inum   =  inum_old Then
    i = i + 1
    end if
    if  oblast <> oblast_old _
    or  inum   <> inum_old Then
     if oblast_old <> "" Then
      j = j + 1
      i = 0
     end if
    end if
    if  j >  glob_j _
    and i <= glob_i then
     redim preserve DataArr2(0 to j,0 to glob_i) as gy_tab   
     glob_j = j
    end if
    if  i >  glob_i _
    and j <= glob_j then
     redim preserve DataArr2(0 to glob_j,0 to i) as gy_tab   
     glob_i = i
    end if
    if i > glob_i and j > gob_j then
     redim preserve DataArr2(0 to j,0 to i) as gy_tab   
     glob_j = j
     glob_i = i
    end if   
    rem заполнить внут. табл.
    DataArr2(j,i).sOblast = oblast
    DataArr2(j,i).iNum    = inum
    DataArr2(j,i).sVar    = ivar
    DataArr2(j,i).sText   = itext   
    oblast_old = oblast
    inum_old   = inum
    ilog   = 1     
    oblast = ""
    inum   = ""
    ivar   = ""
    itext  = "" 

  case else
  end select
wend
Close #iCount
Exit Sub
ErrorHandler:
   Reset
   errcode = "FILE"   
   errstr  = "Файл не существ." & " " & lfilename
   MsgBox errstr,0,"Error"
   Exit Sub
ErrorHandler2:
   Reset
   errcode = "WINDOW" 
   errstr  = "Окно не активно"
   MsgBox errstr,0,"Error"
   Exit Sub
end sub


rem -----------------------------------------------------------
rem            insert_and_copy_row
rem -----------------------------------------------------------
Sub insert_and_copy_row (sOblast as string,nomer as integer)
Dim oRangeAddress    as object
Dim oRangeAddress2   as object
dim oSheet           as object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim oCellAddress 'Адрес назначения
dim posx             as integer
dim posy             as integer
dim errcode          as string
dim errstr           as string
On Error Goto ErrorHandler5
rem Oblast         = "STROKA"
oSheet         = ThisComponent.CurrentController.ActiveSheet
oRangeAddress  = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(sOblast).getRangeAddress()
oRangeAddress2 = oRangeAddress
with oRangeAddress2
.StartRow = .StartRow + nomer + 1
.EndRow   = .EndRow   + nomer + 1
end with
oSheet.insertCells(oRangeAddress2, com.sun.star.sheet.CellInsertMode.ROWS)
posx = oRangeAddress2.StartColumn
posy = oRangeAddress2.StartRow
oCellAddress = ThisComponent.CurrentController.ActiveSheet.getCellByPosition(posx, posy).getCellAddress()
ThisComponent.CurrentController.ActiveSheet.copyRange(oCellAddress, oRangeAddress)
Exit Sub
ErrorHandler5:
   Reset
   errcode = "OBLAST"   
   errstr  = "Область не существ." & " " & sOblast
   MsgBox errstr,0,"Error"
   Exit Sub
end sub


rem ----------------------------------------------------
rem                   ReplaceInString
rem ----------------------------------------------------
Function ReplaceInString(s$, i&, n&, sNew$) As String
If i <= 1 Then
'Поместить строку впереди.
'Единственный вопрос - сколько должно быть удалено из строки.
If n < 1 Then 'Не удаляем ничего
  ReplacelnString = sNew & s
ElseIf n >= Len(s) Then 'Удаляем все
  ReplacelnString = sNew
Else 'Удаляем часть слева
  ReplaceInString = sNew & Right(s, Len(s) - n)
End If
ElseIf i + n > Len(s) Then
'Заменяем в конце, затем извлекаем крайнюю левую часть при помощи
'Mid. Если длина аргумента больше чем строка, то все прекрасно!
'Добавляем новый текст в конец.
ReplaceInString = Mid(s, 1, i - 1) & sNew
Else
'Заменяем где-нибудь в середине строки.
'Сначала, получим крайний левый текст.
'Потом, вставим новый текст, если он присутствует.
'Наконец, добавим самый правый текст.
ReplaceInString = Mid(s, 1, i - 1) & sNew & Right(s, Len(s) - i - n + 1)
End If
End Function