среда, 3 июня 2015 г.

Подведение итогов

Мы рассмотрели в блоке все основные программные блоки, использовавшиеся в надстройке Учет производства, в той или иной комбинации.
После изучения материала вы должны уметь разбираться в программном коде любого макроса, вносить необходимые коррективы, создавать свои, новые уникальные макросы.
Помните, что любой даже самый сложный макрос состоит из множества этих элементарных блоков, связанных кодом и логикой.
Я опустил некоторые незначительные программы типа шкалы выполнения, или пользовательских окон данных, т.к. их реализация немного не типична и полезной функции не несет.
Для добавления новых макросов надстройку в файле Учет производства сделайте видимым лист Config и добавляйте в меню свои обработки
Caption - название макроса (так он будет написан в строке меню)
Module - модуль StarBasic в котором он находится
Macro - имя главного макроса.
Затем переустанавливайте надстройку. Создавать макросы (и модули для них) необходимо в модулях самого файла, а не в общих или установленных.

Этот блог следует изучать последовательно с более ранних публикаций (в обратном порядке следования) начиная с введения.
Желаю Вам успехов в автоматизации работы!

P.S. После написания этого блога решил создать подобный, но для программирования под MS Excel на VBA. В нем будут рассмотрены точно такие же стандартные блоки кода. Изучать его следует после изучения этого. Блог доступен по адресу visualbasicexcel.blogspot.ru
Программирование на VBA имеет гораздо больше возможностей и встроенный мощностей. По нему в интернете доступно очень много обучающей литературы. Для более глубокого ознакомления с языком рекомендую поискать книги по запросу "vba" на сайте http://www.twirpx.com/

Создание контрольных листов

В некоторых обработках,связанных с проверкой ошибок данные с различными возможными ошибками отфильтровываются на отдельные листы. Таких листов в книге может быть очень много.
Чтобы упросить проверку и не просматривать каждый лист в отчете, можно создать один контрольный лист на который будут выведенные данные об ошибках со всех листов. На этом листе будет видно, где есть ошибки, а где нет.
Для таких листов активно используются функции SUM - которая подсчитывает кол-во возвращенных единиц и нулей в функциях вида IF(ISERROR). функции COUNTA - которая посчитывает кол-во непустых заполненных строк на отдельным листе (отфильтрованные строки с ошибками) и функции COUNTIF которая проводит суммирование по условию с отдельных листов.
Рассмотрим часть кода для контрольного листа на примере макроса проверки ВП:

ThisComponent.CurrentController.Select(oCell)
ThisComponent.Sheets(7).getCellByPosition (0, 0).String = "Показатель"
ThisComponent.Sheets(7).getCellByPosition (1, 0).String = "Значение"
ThisComponent.Sheets(7).getCellByPosition (0, 1).String = "Кол-во позиций не СП ГМ в ВП Готовой продукции"
ThisComponent.Sheets(7).getCellByPosition (0, 2).String = "Кол-во штучных позиций в ВП Готовой продукции, списанных дробным числом"
ThisComponent.Sheets(7).getCellByPosition (0, 3).String = "Кол-во ГП в ВП между цехами, заведенных с подтипом Внутри подразделения"
ThisComponent.Sheets(7).getCellByPosition (0, 4).String = "Кол-во штучных позиций в ВП с Торгового зала заведенных дробным числом"
ThisComponent.Sheets(7).getCellByPosition (0, 5).String = "Кол-во позиций ГП, перемещенных с Торгового зала"
ThisComponent.Sheets(7).getCellByPosition (0, 6).String = "Из них рецептов Пекарни, перемещенных с ТЗ на Пекарню"
ThisComponent.Sheets(7).getCellByPosition (0, 7).String = "Из них ГП в ВП Автоматическом (приемка товара не на ту карточку)"
ThisComponent.Sheets (7).getCellByPosition(1, 1).Setformula  ("=COUNTA('Не СП ГМ в ВП Готовой продукции'.C2:C65536)")
ThisComponent.Sheets (7).getCellByPosition(1, 2).Setformula  ("=SUM('Штучные позиции в ВП ГП'.M2:M65536)")
ThisComponent.Sheets (7).getCellByPosition(1, 3).Setformula  ("=COUNTA('ГП в ВП Внутри подразделения_'.C2:C65536)")
ThisComponent.Sheets (7).getCellByPosition(1, 4).Setformula  ("=SUM('Штучные с ТЗ'.M2:M65536)")
ThisComponent.Sheets (7).getCellByPosition(1, 5).Setformula  ("=COUNTA('Перемещение ГП с ТЗ'.C2:C65536)")
ThisComponent.Sheets (7).getCellByPosition(1, 6).Setformula ("=(COUNTIF('Перемещение ГП с ТЗ'.I2:I65536;"&Chr(34) & "=Пекарня" &Chr(34) & ")+COUNTIF('Перемещение ГП с ТЗ'.L2:L65536;"&Chr(34) & "=Пекарня" &Chr(34) & "))/2")
ThisComponent.Sheets(7).getCellByPosition (3, 0).String = "Примечание"
If ThisComponent.Sheets (7).getCellByPosition(1, 1).Value > 0 Then
ThisComponent.Sheets(7).getCellByPosition (3, 1).String = "Есть ошибки"
Else ThisComponent.Sheets(7).getCellByPosition (3, 1).String = "Нет ошибок"
End if
If ThisComponent.Sheets (7).getCellByPosition(1, 2).Value > 0 Then
ThisComponent.Sheets(7).getCellByPosition (3, 2).String = "Есть ошибки"
Else ThisComponent.Sheets(7).getCellByPosition (3, 2).String = "Нет ошибок"
End if
If ThisComponent.Sheets (7).getCellByPosition(1, 3).Value > 0 Then
ThisComponent.Sheets(7).getCellByPosition (3, 3).String = "Есть ошибки"
Else ThisComponent.Sheets(7).getCellByPosition (3, 3).String = "Нет ошибок"
End if
If ThisComponent.Sheets (7).getCellByPosition(1, 4).Value > 0 Then
ThisComponent.Sheets(7).getCellByPosition (3, 4).String = "Есть ошибки"
Else ThisComponent.Sheets(7).getCellByPosition (3, 4).String = "Нет ошибок"
End if
If ThisComponent.Sheets (7).getCellByPosition(1, 5).Value <> ThisComponent.Sheets (7).getCellByPosition(1, 6).Value Then
ThisComponent.Sheets(7).getCellByPosition (3, 5).String = "Есть ошибки"
Else ThisComponent.Sheets(7).getCellByPosition (3, 5).String = "Нет ошибок,  либо есть только перемещения ГП с ТЗ по ГП Пекарни на цех Пекарни (х/б на сухари)"
End if
If ThisComponent.Sheets (7).getCellByPosition(1, 6).Value > 0 Then
ThisComponent.Sheets(7).getCellByPosition (3, 6).String = "Есть ошибки"
Else ThisComponent.Sheets(7).getCellByPosition (3, 6).String = "Нет ошибок"
End if

Если рассмотреть этот код можно определить следующую логику построения:
- в первом столбце пишем название ошибки
- во втором с помощью формул подсчитываем данные об ошибках с разных листов
- в третьем, на основе проверки второго пишем - есть или нет ошибок, впрочем трети столбец не обязателен.

Задача: Потренироваться в программном вводе формул  файле реестр документов по МХ. Создайте новый лист и на нем рассчитайте данные:
- общее число заполненных строк на листе 1
- количество операций Питание персонала
- сумму операций с подтипом Утиль производства ГМ
- сумму операций Утиль производства ГМ и Готовой продукции

Использование сложной функции If Then со многими ElseIf

Функция if then которая отвечает за выполнение или не выполнение каких либо действий по определенному условию может иметь несколько вложенных операторов Elseif и быть довольно сложной.
Рассмотрим пример из макроса Комплексного отчета - построение файла данные для проводок. В этом файле столбец "Сумма документа" копируется в несколько смежных столбцов, где затем заголовки меняются на соот. цех, а данные не принадлежащие этому цеху удаляются. Рассмотрим как это реализуется программно:

Sub Dell_Cell
'Определяем текущий диапазон
 oSheet = ThisComponent.CurrentController.getActiveSheet()
 myrows=oSheet.getrows
 oCellCursor = oSheet.createCursor()
 oCellCursor.GotoStartOfUsedArea(True)
 oCellCursor.GotoEndOfUsedArea(True)
 Start_Row = oCellCursor.getRangeAddress.StartRow
 End_Row = oCellCursor.getRangeAddress.EndRow + 1
 For i=End_Row To Start_Row step -1
'Определяем что содержит ячейка с названием цеха в столбце 10
  text1 = osheet.getcellbyposition(9,i).String
'Если она содержит Производство, тогда в этой строчке удаляем данные из ячеек не 
'принадлежащих производству (другие цеха)
   If Left(text1,12) = "Производство" Then
    osheet.getcellbyposition(3,i).String = ""
    osheet.getcellbyposition(5,i).String = ""
    osheet.getcellbyposition(6,i).String = ""
    osheet.getcellbyposition(7,i).String = ""
    'Если она содержит Пекарня, тогда в этой строчке удаляем данные из ячеек не 
'принадлежащих Пекарне(другие цеха)
      ElseIf Left(text1,17) = "Пекарня" Then
    osheet.getcellbyposition(4,i).String = ""
    osheet.getcellbyposition(5,i).String = ""
    osheet.getcellbyposition(6,i).String = ""
    osheet.getcellbyposition(7,i).String = ""
'И так далее...
          ElseIf Left(text1,8) = "Столовая" Then
    osheet.getcellbyposition(3,i).String = ""
    osheet.getcellbyposition(4,i).String = ""
    osheet.getcellbyposition(6,i).String = ""
    osheet.getcellbyposition(7,i).String = ""
     ElseIf Left(text1,18) = "Цех фасовки овощей" Then
     osheet.getcellbyposition(3,i).String = ""
    osheet.getcellbyposition(4,i).String = ""
    osheet.getcellbyposition(5,i).String = ""
    osheet.getcellbyposition(7,i).String = ""
         ElseIf Left(text1,8) = "-" Then
    osheet.getcellbyposition(3,i).String = ""
    osheet.getcellbyposition(4,i).String = ""
    osheet.getcellbyposition(5,i).String = ""
        osheet.getcellbyposition(6,i).String = ""
   End if   
   Next i
   End Sub

Задача: Откройте необработанный файл реестр документов по МХ - скопируйте столбец сумма в два столбцы правее (оставив предварительно пустые столбцы). Откорректируйте приведенный выше макрос по ваш файл и сделайте обработку на цеха Производства, Пекарни, Столовой.

Использование функции Go To при построении сводных таблиц

В некоторых макросах обработки файлов, в середине обработки может возникнуть необходимость построения сводной таблицы, но может оказаться так, что данных для ее построения не будет. Например в макросе проверки не привязанных позиций на каком-либо МХ их может не оказаться и сводная начнет строится на пустых данных. В этом случае ООО аварийно завершит работу, не закончив выполнение кода до конца.
Чтобы программно обойти возможный ошибочный кусок кода можно использовать функцию go to  с условием перенаправления на строку сразу после этого кода. Поясним на примере построения одной из сводных в макросе не привязанных позиций.

Sub Chist_PK ()
oSheet = ThisComponent.createInstance ("com.sun.star.sheet.Spreadsheet")
ThisComponent.Sheets.insertByName ("Ч_Пекарня", oSheet)
' Определим переменную oshipka она будет равна ячейке А2 на листе с отфильтрованными
' данными по которым будет строится наши сводная таблица
oshipka = ThisComponent.Sheets(3).getCellRangeByName("A2")
' Если эта ячейка окажется пуста, значит весь диапазон пуст, т.к. она является первой ячейкой
If oshipka.String = "" Then
'Перенаправить код на Line 1
GoTo Line1
End If
Dim oRange 'Диапазон - источник для сводной таблицы
Dim oRangeAddress'Адрес объекта диапазон
Dim oTables 'Совокупность сводных таблиц
Dim oTDescriptor 'Один описатель сводной таблицы
Dim oFields 'Совокупность всех полей
Dim oField 'Одно поле
Dim oCellAddress As New com.sun.star.table.CellAddress
CreateDataPilotSource = oRange
oRange = CreateDataPilotSource("Сводка")
oSheet = ThisComponent.getSheets().getByIndex(3)
oRangeAddress = ThisComponent.getSheets().getByIndex(3).getCellRangeByName("A1:B65535").getRangeAddress()
oRangeAddress2 = ThisComponent.Sheets (9).getCellByPosition(0, 0).getCellAddress()
oSheet = ThisComponent.Sheets.getByName("Ч_Пекарня")
oTables = oSheet.getDataPilotTables()
REM Шаг 1, создадим описатель
oTDescriptor = oTables.createDataPilotDescriptor()
REM Шаг 2, Зададим исходный диапазон
oTDescriptor.setSourceRange(oRangeAddress)
REM Шаг 3, Зададим поля
oFields = oTDescriptor.getDataPilotFields()
REM Столбец 0 в источнике - Предмет и Я я хочу его как строку Предмет.
oField = oFields.getByIndex(1)
oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
oTables.insertNewByName("MyFirstDataPilot", oRangeAddress2, oTDescriptor)
oSheet = ThisComponent.Sheets (9)
oRangeAddress = oSheet.getCellRangeByName("A1:A3").getRangeAddress()
oSheet.removeRange(oRangeAddress,  com.sun.star.sheet.CellDeleteMode.UP)
 oDoc = ThisComponent 
   oSheet = ThisComponent.getSheets().getByIndex(9) 
    oAddr = oSheet.getCellRangeByName("A1:A65535").getRangeAddress() 
    oDoc.DatabaseRanges.addNewByName("пекарня", oAddr) 
  oRange = oDoc.DatabaseRanges.getByName("пекарня")
 oSheet = ThisComponent.Sheets(9)
 myrows=oSheet.getrows
 oCellCursor = oSheet.createCursor()
 oCellCursor.GotoStartOfUsedArea(True)
 oCellCursor.GotoEndOfUsedArea(True)
 Start_Row = oCellCursor.getRangeAddress.StartRow
 End_Row = oCellCursor.getRangeAddress.EndRow + 1
 For i=End_Row To Start_Row step -1
  text1 = osheet.getcellbyposition(0,i).String
   If Left(text1,4) = "Итог" Then
    myrows.removebyindex(i,1)
   End if   
   Next i
'И выполнение кода начнется с этой строчки, пропуская весь процесс построения сводной
      Line1:
' В на листе, на котором должна была быть сводная просто напишем следующее
   ThisComponent.Sheets(9).getCellByPosition (9, 0).String = "Нет таких позиций" 
End Sub

Задание: простойте простую сводную в файле реестр документов по МХ (произвольную на новый лист) с включенным условием go to которое проверяет содержимое ячейки A1. Проверьте код выполнением. Затем проведите отмену всех изменений и удалите данные из ячейки A1  - снова запустите код - проверьте результат работы и корректность работы функции обхода.

Сохранение данных в разные файлы

В функциях обработок отчетов может возникнуть необходимость сохранить исходный файл со множеством обработанных и расчетных листов в разные файлы (например в макросе комплексной обработки). Сохранение части данных осуществляется путем удаления лишних листов, сохранения файла с нужным именем и отменой удаления этих листов.
Рассмотрим код одного из таких макросов. Из файла Данные для проводок нам нужно получить файл Название ГМ дата списания:

Sub Sox
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oSheet = ThisComponent.createInstance ("com.sun.star.sheet.Spreadsheet")
'Удаляем из файла Данные для проводок ненужные листы
ThisComponent.Sheets.removeByName ("Списание ингредиентов ГМ", oSheet)
ThisComponent.Sheets.removeByName ("Списание ингредиентов АР", oSheet)
ThisComponent.Sheets.removeByName ("Питание персонала", oSheet)
ThisComponent.Sheets.removeByName ("Производство", oSheet)
ThisComponent.Sheets.removeByName ("Производство АР", oSheet)
ThisComponent.Sheets.removeByName ("Данные для проводок", oSheet)
' Вызываем стандартную функцию сохранения файла с нужным именем
 If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then
    GlobalScope.BasicLibraries.LoadLibrary("Tools")
  End If
  oDoc = ThisComponent
 sDocURL = oDoc.getURL()
Puti = DirectoryNameoutofPath(sDocURL,"/")
dim args17(2) as new com.sun.star.beans.PropertyValue
args17(0).Name = "URL"
args17(0).Value = Puti & "/" & ThisComponent.Sheets (0).getCellByPosition(0, 0).String & " списания .xls"
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args17())
'Вызываем функции отмены удаления листов, каждая строчка удаляет одно действие
'Так как мы удалили шесть листов строчек тоже будет шесть
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
oSheet = ThisComponent.createInstance ("com.sun.star.sheet.Spreadsheet")
'Далее мы будем вызывать из файла данные для проводок другие обработки сохранения
'Будут удаляться другие листы.
Sox2
Sox3
End sub

Задача: в любом созданном ранее макросе допишите к конец главного макроса строчки
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Undo", "", 0, Array())
Данный код будет вызывать отмену трех последних действий - проверьте результат.

Отправка отчетов по электронной почте

Многие отчеты после формирования не требуют какой-либо обработки и предполагают отправку данного отчета сразу по e-mail. Либо же даже в случае обработки конечный отчет все равно отправляется по почте. ООО позволяет автоматизировать и эту часть работы. Существуют две формы отправки таких отчетов сразу без пользовательского окна и полуавтомат, который открываем новое окно в почтовом клиенте с уже вложенным файлом и нужной темой. Можно даже стандартизировать текст тела сообщения, предварительно набрав его в файле и скопировав (напрямую ООО не позволяет писать тело сообщения).
Рассмотрим код из макроса Не привязанные позиции:

Sub Email_Neprivaz
'Сохраняем документ со всеми изменениями
ThisComponent.Store ()
'Объявляем переменные (стандартный блок)
Dim eMailAddress As String
Dim eSubject As String
Dim eMailer As Object
Dim Title As String
Dim Loc As String
Dim eMailClient As Object
Dim eMessage As Object
'Устанавливаем тему сообщения - в тему можно включать содержимое любых ячеек
eSubject = "Отчет Не привязанные позиции ГМ " & ThisComponent.Sheets (0).getCellByPosition(1, 0).String
'Создаем обработчик простой отправки
Title = thisComponent.CurrentController.Frame.Title
eMailer = createUnoService("com.sun.star.system.SimpleSystemMail")
eMailClient = eMailer.querySimpleMailClient()
eMessage = eMailClient.createSimpleMailMessage()
eMessage.setRecipient ("")
eMessage.setSubject (eSubject)
' Пишем, что вложением будет текущий документ
eMessage.setAttachement (Array(convertToUrl(ThisComponent.Location))
'Создаем в нашем документа строки, которые хотим вставить в тело собщения
' потом мы их удалим
ThisComponent.Sheets (0).getCellByPosition(4, 4).String = "Добрый день."
ThisComponent.Sheets (0).getCellByPosition(4, 5).String = "Во вложении Отчет не привязанные позиции ГМ " & ThisComponent.Sheets (0).getCellByPosition(1, 0).String
Sheet = ThisComponent.Sheets(0)
'Устанавливаем для этих строк оптимальную ширину, чтобы корректно скопировать
Columns = Sheet.Columns(4)
Columns.OptimalWidth = True
oCalcDoc = ThisComponent
oCalcCtrl = oCalcDoc.getCurrentController()
oSheet = oCalcDoc.getSheets().getByIndex( 0 )
oCellRanges = oCalcDoc.createInstance( "com.sun.star.sheet.SheetCellRanges" )
'Выделяем нужные нам ячейки
oCellRanges.addRangeAddress( oSheet.getCellRangeByName( "E5:E6" ).getRangeAddress(), False )
oCalcCtrl.select( oCellRanges )
'Вызываем функцию копирования
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
'Удаляем эти ячейки - они уже не нужны, мы все скопировали в буфер
ThisComponent.Sheets(0).Columns.removeByIndex(4,1)
oCell = ThisComponent.Sheets (0).getCellByPosition(0, 0)
ThisComponent.CurrentController.Select(oCell)
'Вызываем отправку сообщения
eMailClient.sendSimpleMailMessage ( eMessage, com.sun.star.system.SimpleMailClientFlags.DEFAULTS )
End Sub

После выполнения макроса перед вами откроется окно почтового клиента с новым письмом. Вам нужно встать в поле тела сообщения и нажать CTRL+V для того чтобы вставить текст из буфера обмена. Затем указываем адреса и отправляем.

Задача: Сделать макрос для отправки по почте отчета Сверка ДЗЛ за период, со стандартной темой и текстом сообщения.

Создание выпадающего списка значений

В некоторых отчетных формах, которые предполагают дальнейший анализ данных пользователем требуется создание выпадающих списков определенных значений (комментариев). Использование таких списков удобно для стандартизации работы,  а также для подсказок вариантов неопытным пользователям.
Рассмотрим код формирования такого списка из макроса Не привязанные позиции:

Sub SetValidationRange
Dim oRange
Dim oValidation 'Объект проверки
 'Диапазон, который допускает проверку, конечную ячейку можно устанавливать произвольно
' далеко - так чтобы не зная размеров диапазона выпадающие комментарии не закончились
oRange = ThisComponent.Sheets(0).getCellRangeByName("D3:D10000")
'Получим объект проверки
oValidation = oRange.Validation
'Настроим проверку для выполнения
oValidation.Type = com.sun.star.sheet.ValidationType.LIST
oValidation.setOperator(com.sun.star.sheet.ConditionOperator.BETWEEN)
oValidation.setFormula1(""& Chr(34) &"Ошибочное перемещение позиции не по акту заборки"& Chr(34) &";" & Chr(34) & "Неверное МХ в операции внутреннего перемещения"& Chr(34) & ";" & Chr(34) &"Ошибка при заведении операции инвентаризации"& Chr(34) &";"& Chr(34) &"Новое сырье, отправлен запрос на привязку"& Chr(34) &";"& Chr(34) &"Сырье, не используемое в производстве"& Chr(34) &";"& Chr(34) &"Нарушение привязки позиции к рецептам в БД, отправлен запрос на исправление"& Chr(34) &";"& Chr(34) &"Ошибка при заведении операции списания утиля"& Chr(34) &";"& Chr(34) &"Другое"& Chr(34) &"")
' Параметр setFormula2  является по сути последним комментарием, Если вы указали все
' ранее - оставьте это поле пустым
oValidation.setFormula2("Иная причина")
'Теперь установим проверку
oRange.Validation = oValidation
End Sub

Задача: разработайте и запрограммируйте выпадающий список значения для файла Продажи без рецептов

Использование двойного цикла for to next

При форматировании документов во многих случаях удобно использовать двойной цикл for to next для того чтобы придать определенным ячейкам, срокам или столбцам какой-либо параметр или заливку. Сам макрос читается в этом случае как - пройти по всем указанным ячейкам, и если условия выполняется придать им определенное значение. Поясним на примере кода из макроса Разбивка инвентаризации для объяснительной:

Sub Cveta
'Обозначаем текущий лист и диапазон
 oSheet = ThisComponent.Sheets(0)
 oCellCursor = oSheet.createCursor()
 oCellCursor.GotoStartOfUsedArea(True)
 oCellCursor.GotoEndOfUsedArea(True)
 Start_Row = oCellCursor.getRangeAddress.StartRow
 End_Row = oCellCursor.getRangeAddress.EndRow + 1
'Указываем что программе нужно пройти от первой до последней строки с столбце 7
 For i=End_Row To Start_Row step -1
  For j=0 To 6
'Указываем искомые значение и что вернуть в случае их нахождения
  text1 = osheet.getcellbyposition(6,i).Value
   If text1 < -5000 Then
'Если значение ячейки меньше -5000 - окрасить ее в желтый цвет
    oSheet.getCellByPosition (j,i).CellBackColor = 16777113
' Если больше 5000 - окрасить ее в красный цвет
    Else if  text1 > 5000 Then
    oSheet.getCellByPosition (j,i).CellBackColor = 16750950
    End if
   End if   
   Next j
   Next i
End Sub

Рассмотрим еще пример. Функция применения автоширины на всех указанных листах для всех указанных диапазонов:

 Sub Tema
'Пройти с листа 1 по лист 4
 For j=0 To 3
 Sheet = ThisComponent.Sheets(j)
'Применить на всех этих листах для столбцов с 1 по 9 автоширину.
For I = 0 To 8
Columns = Sheet.Columns(I)
Columns.OptimalWidth = True
Next I
Next j

Задача: В файле содержащем три листа (можно одинаковых) применить для всех первых строк (заголовков) - жирный шрифт.

Комбинации IF(OR) и IF(AND) и их использование в проверке и фильтрации

Проверяя документы с массивами различных данных часто нужна возможность отфильтровать отдельных диапазон по ряду схожих условий. Если таких условий много, фильтровать по отдельности не очень удобно и нужно привести их в сопоставимый вид.
Приведем пример, что имеется в виду. Допустим из массива данных реестра документов по мх нужно отфильтровать на отдельный лист только подтипы списаний, относящиеся к производственным. В данном случае можно сделать добавочный столбец, в котором мы проведем проверку на условия с помощью функции IF(OR) - если значение будет верным будет возвращаться строка "Производственные", иначе "ТЗ" (можно реализовать через возвращение 1 или 0 - так будет проще). Затем уже по этому столбцу можно провести одиночный фильтр по нужному значению.
Рассмотрим код:

 Sub Priznak_Tip
odoc=thiscomponent
oSheet = ThisComponent.Sheets(0)
oCellCursor = oSheet.createCursor()
oCellCursor.GotoStartOfUsedArea(True)
oCellCursor.GotoEndOfUsedArea(True)
Start_Row = oCellCursor.getRangeAddress.StartRow
End_Row = oCellCursor.getRangeAddress.EndRow
currcell = osheet.getcellbyposition(6, End_Row)
currcell3 = osheet.getcellbyposition(11, End_Row)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
'Вот собственно сама сложная формула. При построении очень важно соблюдать
'порядок операторов, кавычки, правильно расставлять скобки
 Podstanovka  =  "=IF(OR("& oConv2.UserInterfaceRepresentation & "=" &Chr(34) & "Утиль производства ГМ"&Chr(34) &";"& oConv2.UserInterfaceRepresentation &"=" &Chr(34) &"Анализы СЭС"&Chr(34) &";"& oConv2.UserInterfaceRepresentation &"=" &Chr(34) &"Ингредиенты производства АР"&Chr(34) &";"& oConv2.UserInterfaceRepresentation &"=" &Chr(34) &"Ингредиенты производства ГМ"&Chr(34) &";"& oConv2.UserInterfaceRepresentation &"=" &Chr(34) &"Питание персонала"&Chr(34) &";"& oConv2.UserInterfaceRepresentation &"=" &Chr(34) &"Сертификация"&Chr(34) &";"& oConv2.UserInterfaceRepresentation &"=" &Chr(34) &"Дегустация"&Chr(34) &");"& Chr(34) & "Производственные" & Chr(34) & ";"& Chr(34) & "ТЗ" & Chr(34) & ")"
 currcell3.setFormula (Podstanovka)
odoc.getCurrentController().Select(currcell3)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args29(1) as new com.sun.star.beans.PropertyValue
args29(0).Name = "By"
args29(0).Value = 1
args29(1).Name = "Sel"
args29(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, args29())
dispatcher.executeDispatch(document, ".uno:FillUp", "", 0, Array())
ThisComponent.Sheets(0).getCellByPosition (11, 0).String = "Признак подтипа операции"
 End Sub

Оператор OR означает или - т.е. должно выполняться любое из перечисленных условий, что бы он вернул верное значение. Существует еще оператор AND - при этого использовании должны выполняться все условия, указанные в кавычках, чтобы он вернул верное значение.
Обычно его используют для проверки ошибок в данных. Например, следующая строка проверяет на условие позиция является рецептом, а списание относится к производству (что является ошибкой:

 Podstanovka  =  "=IF(AND("& oConv.UserInterfaceRepresentation & "=" &Chr(34) & "рец."&Chr(34) &";"& oConv2.UserInterfaceRepresentation &"=" &Chr(34) &"Производство" &Chr(34) &");1;0)"

Задача: С помощью оператора IF(AND) проверьте в файле Реестр документов по МХ наличие списаний  подтипом Утиль производства ГМ с МХ Брак-утиль с помощью дополнительного столбца с соот. формулой.

Фильтрация по сдвоенному условию. Функция Concatenate.

При фильтрации некоторых документов иногда возникает необходимость отфильтровать документ по данным, расположенным в разных столбцах, но при этом отфильтровать по каждому условию отдельно нет возможности. Например, нам нужно убрать из реестра строки и параметрами Производство и Производство. Убрать отдельно Производство мы не можем, т.к. в нему относятся и другие операции (не Производство). Также мы не можем отдельно убрать Производство, т.к. этот подтип может относится к другим цехам. В этом случае следует воспользоваться обходным приемом как и c функцией SEARCH - в отдельно столбце сцепить нужные нам строки и затем удалить только нужную (в примере описанного случая будет сцепка "ПроизводствоПроизводство".
Рассмотрим код:

Sub NeRec
odoc=thiscomponent
oSheet = ThisComponent.Sheets(0)
oCellCursor = oSheet.createCursor()
oCellCursor.GotoStartOfUsedArea(True)
oCellCursor.GotoEndOfUsedArea(True)
Start_Row = oCellCursor.getRangeAddress.StartRow
End_Row = oCellCursor.getRangeAddress.EndRow
currcell = osheet.getcellbyposition(11, End_Row)
currcell4 = osheet.getcellbyposition(5, End_Row)
currcell5 = osheet.getcellbyposition(6, End_Row)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv4 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv4.Address = currcell4.getCellAddress
oConv5 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv5.Address = currcell5.getCellAddress
' Функция Concatenate сцепляем содержимое столбцов Название контрагента и 
' Название типа операции
 Podstanovka  =   "=Concatenate(" & oConv4.UserInterfaceRepresentation &  ";" & oConv5.UserInterfaceRepresentation  & ")"
 currcell.setFormula (Podstanovka)
 odoc.getCurrentController().Select(currcell)
 dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args19(1) as new com.sun.star.beans.PropertyValue
args19(0).Name = "By"
args19(0).Value = 1
args19(1).Name = "Sel"
args19(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, args19())
dispatcher.executeDispatch(document, ".uno:FillUp", "", 0, Array())
'В столбце 12 у нас получается уникальная сцепка
ThisComponent.Sheets(0).getCellByPosition (11, 0).String = "Уникаль"
' Вызываем фильтр по этому столбцу - на новый лист по типу не равно
Filt_NeRec
End Sub

 Sub Filt_NeRec
 Dim oDescriptor,oNewDescriptor,bCopyOutputData as Boolean, bUseCriteria as Boolean 
 oDoc = ThisComponent 
   oSheet = ThisComponent.getSheets().getByIndex(0) 
    oAddr = oSheet.getCellRangeByName("A1:L65535").getRangeAddress() 
    oDoc.DatabaseRanges.addNewByName("MyName", oAddr) 
  oRange = oDoc.DatabaseRanges.getByName("MyName") 
set oDescriptor = oRange.getFilterDescriptor
oSheet = ThisComponent.createInstance ("com.sun.star.sheet.Spreadsheet")
ThisComponent.Sheets.insertByName ("Новый лист", oSheet)
oCellAddress = ThisComponent.Sheets (1).getCellByPosition(0, 0).getCellAddress()
oFD = oRange.getFilterDescriptor()
With oFD
.CopyOutputData  = True
.OutputPosition = (oCellAddress)
End With
oField = createUnoStruct("com.sun.star.sheet.TableFilterField")
With oField
  .Field = 11
  .Operator = com.sun.star.sheet.FilterOperator.NOT_EQUAL
  .StringValue = "ПроизводствоПроизводство"
  End With
oFD.setFilterFields(Array(oField))
oRange.refresh()
End Sub

Задача: Сделать аналогичный фильтр по типам Утиль Производства Торговый зал.

Функция SEARCH для поиска текста внутри предложений

Для некоторых программ проводящих фильтрацию данных документа возникает необходимость убрать/отфильтровать строки содержащие определенное слово или словосочетание. Обычные функции типа LEFT не подходят - т.к. это слово может встретиться в любой части строки - в начале, середине, конце.
Для решения такой задачи можно использовать построение дополнительных столбцов с функцией SEARCH, которая ищет заданное слово во всей строке. Для каждого условия нужен отдельный столбец для построения. Функция возвращает число больше нуля, если строка найдена (число будет обозначать порядковый номер первого символа найденного слова). Если у итоге нужно отфильтровать все условия эти числа просто суммируются с отдельном столбце и затем проводится фильтрация по условию не равно нулю.
Рассмотрим код из макроса "Продажи без рецептов":

Sub Formul_poisk
  oCell = ThisComponent.Sheets(0).GetCellbyPosition( 0, 0 )
ThisComponent.CurrentController.Select(oCell)
odoc=thiscomponent
oSheet = ThisComponent.Sheets(0)
oCellCursor = oSheet.createCursor()
oCellCursor.GotoStartOfUsedArea(True)
oCellCursor.GotoEndOfUsedArea(True)
Start_Row = oCellCursor.getRangeAddress.StartRow
End_Row = oCellCursor.getRangeAddress.EndRow
currcell = osheet.getcellbyposition(11, End_Row)
currcell2 = osheet.getcellbyposition(3, End_Row)
currcell3 = osheet.getcellbyposition(12, End_Row)
currcell5 = osheet.getcellbyposition(13, End_Row)
currcell4 = osheet.getcellbyposition(14, End_Row)
currcell7 = osheet.getcellbyposition(15, End_Row)
currcell16 = osheet.getcellbyposition(16, End_Row)
currcell8 = osheet.getcellbyposition(8, End_Row)
oConv8 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv8.Address = currcell8.getCellAddress
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv2 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = currcell2.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
oConv5 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv5.Address = currcell5.getCellAddress
oConv4 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv4.Address = currcell4.getCellAddress
oConv7 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv7.Address = currcell16.getCellAddress
oConv16 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv16.Address = currcell16.getCellAddress
'Данными формулами мы ищем во всех строках нужные нам сочетания
' Причем каждую строку мы проверяем на все сочетания
 Podstanovka  = "=SEARCH("&Chr(34) &"фас"& Chr(34) &";" & oConv2.UserInterfaceRepresentation & ")"
 currcell.setFormula (Podstanovka)
  Podstanovka2  = "=SEARCH("&Chr(34) &"уценен"& Chr(34) &";" & oConv2.UserInterfaceRepresentation & ")"
 currcell3.setFormula (Podstanovka2)
   Podstanovka3  = "=SEARCH("&Chr(34) &"СП ГМ"& Chr(34) &";" & oConv2.UserInterfaceRepresentation & ")"
currcell5.setFormula (Podstanovka3)
odoc.getCurrentController().Select(currcell)
   Podstanovka4  = "=SEARCH("&Chr(34) &"СПГМ"& Chr(34) &";" & oConv2.UserInterfaceRepresentation & ")"
currcell4.setFormula (Podstanovka4)
odoc.getCurrentController().Select(currcell)
   Podstanovka5  = "=SEARCH("&Chr(34) &"СП  ГМ"& Chr(34) &";" & oConv2.UserInterfaceRepresentation & ")"
currcell7.setFormula (Podstanovka5)
   Podstanovka6  = "=SEARCH("&Chr(34) &"разлив"& Chr(34) &";" & oConv2.UserInterfaceRepresentation & ")"
currcell16.setFormula (Podstanovka6)
odoc.getCurrentController().Select(currcell)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args19(1) as new com.sun.star.beans.PropertyValue
args19(0).Name = "By"
args19(0).Value = 1
args19(1).Name = "Sel"
args19(1).Value = true
'Выделяем весь нижний ряд формул
dispatcher.executeDispatch(document, ".uno:GoRightToEndOfData", "", 0, args19())
dim args29(1) as new com.sun.star.beans.PropertyValue
args29(0).Name = "By"
args29(0).Value = 1
args29(1).Name = "Sel"
args29(1).Value = true
' Протягиваем все полученные формулы вверх до конца столбцов
dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, args29())
dispatcher.executeDispatch(document, ".uno:FillUp", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:FillUp", "", 0, Array())
'вставляем осмысленные заголовки
ThisComponent.Sheets(0).getCellByPosition (11, 0).String = "Поиск сочетания "&Chr(34) &"фас"& Chr(34) & ""
ThisComponent.Sheets(0).getCellByPosition (12, 0).String = "Поиск сочетания "&Chr(34) &"уценен"& Chr(34) &""
ThisComponent.Sheets(0).getCellByPosition (13, 0).String = "Поиск сочетания "&Chr(34) &"СП ГМ"& Chr(34) &""
ThisComponent.Sheets(0).getCellByPosition (14, 0).String = "Поиск сочетания "&Chr(34) &"СПГМ"& Chr(34) &""
ThisComponent.Sheets(0).getCellByPosition (15, 0).String = "Поиск сочетания "&Chr(34) &"СП  ГМ"& Chr(34) &""
ThisComponent.Sheets(0).getCellByPosition (16, 0).String = "Поиск сочетания "&Chr(34) &"разливное"& Chr(34) &""
'Убираем формулы
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
dim args2(5) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Flags"
args2(0).Value = "SV"
args2(1).Name = "FormulaCommand"
args2(1).Value = 0
args2(2).Name = "SkipEmptyCells"
args2(2).Value = false
args2(3).Name = "Transpose"
args2(3).Value = false
args2(4).Name = "AsLink"
args2(4).Value = false
args2(5).Name = "MoveMode"
args2(5).Value = 4
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args2())
'Меняем ошибку "#ЗНАЧЕН!" на ноль (это можно сделать и помощью более короткой
' функции поиска и замены описанной ранее)
dim args1(17) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.Backward"
args1(4).Value = false
args1(5).Name = "SearchItem.Pattern"
args1(5).Value = false
args1(6).Name = "SearchItem.Content"
args1(6).Value = false
args1(7).Name = "SearchItem.AsianOptions"
args1(7).Value = false
args1(8).Name = "SearchItem.AlgorithmType"
args1(8).Value = 1
args1(9).Name = "SearchItem.SearchFlags"
args1(9).Value = 65536
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = "#ЗНАЧЕН!"
args1(11).Name = "SearchItem.ReplaceString"
args1(11).Value = "0"
args1(12).Name = "SearchItem.Locale"
args1(12).Value = 255
args1(13).Name = "SearchItem.ChangedChars"
args1(13).Value = 2
args1(14).Name = "SearchItem.DeletedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.InsertedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.TransliterateFlags"
args1(16).Value = 1280
args1(17).Name = "SearchItem.Command"
args1(17).Value = 3
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
'Вводим еще одни столбец для суммирования
 currcell6 = osheet.getcellbyposition(17, End_Row)
 oConv6 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv6.Address = currcell6.getCellAddress
'Складываем полученные цифры во всех столбцах в один, чтобы в последствие по нему 'провести фильтрацию по признаку не равно нулю
Modul3 =  "=IF(" & oConv.UserInterfaceRepresentation & "+" & oConv3.UserInterfaceRepresentation & "+" & oConv5.UserInterfaceRepresentation & "+" & oConv4.UserInterfaceRepresentation & "+" & oConv7.UserInterfaceRepresentation &   "+" & oConv16.UserInterfaceRepresentation & " >0;0;1)"
currcell6.setFormula (Modul3)
odoc.getCurrentController().Select(currcell6)
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args195(1) as new com.sun.star.beans.PropertyValue
args195(0).Name = "By"
args195(0).Value = 1
args195(1).Name = "Sel"
args195(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, args195())
dispatcher.executeDispatch(document, ".uno:FillUp", "", 0, Array())
ThisComponent.Sheets(0).getCellByPosition (17, 0).String = "Сравнение"
End Sub

P.S. Чтобы не заниматься заменой ошибок ЗНАЧЕН и не удалять формулы можно воспользоваться как и с функцией VLOOKUP более сложным вариантом формулы с использованием IF и ISERROR;

 Podstanovka  = "=IF(ISERROR(SEARCH("&Chr(34) &"сырье"& Chr(34) &";" & oConv2.UserInterfaceRepresentation & "));0;1)"

Задача: В файле реестр товарных позиций, запущенному по подтипам списаний по МХ осуществить поиск по условиям "сырье" и "п\ф" в двух крайних столбцах с помощью усложненной формулы. Ввести суммирующих столбец и по нему отфильтровать данные на новый лист по признаку равно нулю.

Определение месяца формирования документа

В стандартных обработках часто нужно указать в итоговом отчете за какой месяц сформирован документ. Причем указать не цифрой, а словом. Стандартной функции для этого во внутреннем языке нет, поэтому используется конструкция Select Case для явного обозначения каждого месяца исходя из дат имеющихся в документе. Например, мы получаем содержимое ячейки B2 в файле реестр документов по МХ - первая ячейка с датой и на ее основе выводим месяц документа. Рассмотрим код:

Dim Data as String
'Стандартная функция MONTH вытаскивает из ячеек с датой номер месяца
Select Case MONTH(ThisComponent.Sheets (0).getCellByPosition(1, 1).Value)
' Следующий цикл очень похож на if then - т.е. выводить что-либо по условию
'но если условий много - лучше использовать Select Case
' Далее все просто - если Case равен единице, значит месяц январь и тд.
Case 1
Data = "январь"
Case 2
Data = "февраль"
Case 3
Data = "март"
Case 4
Data = "апрель"
Case 5
Data = "май"
Case 6
Data = "июнь"
Case 7
Data = "июль"
Case 8
Data = "август"
Case 9
Data = "сентябрь"
Case 10
Data = "октябрь"
Case 11
Data = "ноябрь"
Case 12
Data = "декабрь"
End Select
Dim GM
' А в данной строчке мы добавим к нашей переменной Data c названием месяца - год
' В итоге получится строчка в виде -  июнь 2014
GM = Data & " " & YEAR(ThisComponent.Sheets (0).getCellByPosition(1, 1).Value)

Задача: В Файле Реестр товарных позиций по МХ получите название месяца по первой заполненной ячейке столбца Дата. Определите с из какого столбца лучше получить наименование ГМ (нужно будет с помощью поиска и замены удалить лишний текст справа от названия). Методом сцепки вывести в ячейку А1 фразу ГМ Название за месяц год.
Из примера выше видно что сцепки осуществляются с помощью символов &, между ними обычно вставляют пробелы " " чтобы итоговая строка была удобочитаемой.

вторник, 2 июня 2015 г.

Автоматическое открытие следующего файла

Ранее мы рассмотрели функцию AddFile которая предназначена для открытия файлов для последующей вставки в них данных из предыдущего файла посредством вызова окна выбора файла. Данная реализация не очень удобна, т.к. такие обработки часто приводят к ошибкам - когда из-за подвисания новый файл еще не открылся, а код предназначенный для него начал выполняться в старом файле.
Что избежать таких ошибок лучше использовать автоматическое открытие новых файлов через непосредственный запрос к нему. Здесь важно чтобы второй файл сохранялся в ту же папку что и первоначальный и имел строго то имя, которое заданно в коде программы.

Напомним. что стандартная реализация с окном выбора обычно состоит из след. строк:

'Скопировали нужное содержимое первого документа
Coping
'Вызываем функцию открытия файла
AddFile ()
'Включаем функцию ожидания
For i = 1 To 3000000 : Next
.......
' Последующий код обработки

В случае автоматической обработки оператор AddFile отсутствует, также отсутствует строка ожидания. Вместо них вызывают одной строчкой написанный макрос открытия файла.
Рассмотрим код такого макроса:

Sub Open_RD_MX
'Определяем переменные документа и диспетчера (стандартно)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
 If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then
    GlobalScope.BasicLibraries.LoadLibrary("Tools")
  End If
  oDoc = ThisComponent
 sDocURL = oDoc.getURL()
'Указываем что искомая папка, где искать второй файл - это папка где находится текущий открытый файл
Puti = DirectoryNameoutofPath(sDocURL,"/")
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
'указываем путь к файлу, содержащий путь папки и конкретное имя файла, который нужно открыть
args1(0).Value = Puti & "/Реестр документов ГМ.xls"
'Вызываем сам обработчик открытия
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Open", "", 0, args1())

End sub

Задача: Переделайте макрос из поста "Обработка нескольких файлов", добавив в модуль обработки макрос Open_RD_MX и заменив в коде главного макроса строки:

AddFile ()
For i = 1 To 3000000 : Next

На:

Open_RD_MX

Оставив весь остальной код без изменений.


Самостоятельная работа

На основе полученных знаний самостоятельно создать макрос аналогичный Отчет «Продажи блюд производства (с отгрузками)» из Учет производства с листами ГМ Доработан, ГМ, Фасовка, с необходимой фильтрацией, подбитием итогов в нужных столбцах и выставлением 2-х знаков после занятой на всех листах, согласно инструкции по формированию этого файла.

Создание первой простой обработки

В предыдущих постах мы рассмотрели основные программные блоки необходимые для большинства обработок отчетов в Calc. Эти блоки можно копировать в свои макросы и изменяя параметры создавать новые уникальные обработки. В этом посте мы сделаем первую полноценную обработку на основе простого макроса Учет производства "Отчет средняя себестоимость комплексов" на основе файла "Продажи блюд производства (с отгрузками)".
Составим техническое задание для данного макроса:
1. Необходимо отфильтровать на отдельный лист только списания комплексов с МХ Столовая
2. Вставить столбец СтолСебсНДС и провести в нем расчеты НДС
3. Подсчитать итоги по столбцам - суммы средние значения.

Выгрузим и откроем файл "Продажи блюд производства (с отгурзками)". Откроем его и нажмем сочетание клавиш ALT+F11. Раскроем библиотеку Standart, встаем курсом на Mоdule 1 и жмем "Редактировать". Откроется окно редактора StarBasic. Внизу на закладках модулей жмем ПКМ  - Вставить - Модуль Basic.Переименуем в его Stolov. В этом модуле есть заготовка Sub Main. Поменяем Main на что-нибудь осмысленное. Т.к. он будет главным модулем - дадим имя Stolov - одноименные имена модуля бейсик и главного макроса очень удобно использовать.
Начнем заполнять код нашими заготовками, если будут попадаться не изученные куски кода - буду комментировать подробнее.

Sub Stolov
'Первое что нужно сделать - это убедиться что открыт нужный файл:
Dim oCellAddress 'Адрес назначения
oCelles = ThisComponent.Sheets(0).getCellRangeByName("D1") 'находит ячейку D1
If oCelles.String <> "Цех" Then 'если значение в ячейке D1 не равно "Цех", то выдает ошибку
MsgBox " Данный файл не является отчетом" & Chr$(13) & "Продажи блюд производства с отгрузками, либо имеет поврежденную структуру" & Chr$(13) & "Экспортируйте  отчет Продажи блюд производства с отгрузками за нужный период и откройте его",16, "Предупреждение:"
Exit Sub
End If
'Фильтруем на новый лист по полю Цех данные по столовой
 Dim oDescriptor,oNewDescriptor,bCopyOutputData as Boolean, bUseCriteria as Boolean 
 oDoc = ThisComponent 
   oSheet = ThisComponent.getSheets().getByIndex(0) 
    oAddr = oSheet.getCellRangeByName("A1:AF65535").getRangeAddress() 
    oDoc.DatabaseRanges.addNewByName("MyName", oAddr) 
  oRange = oDoc.DatabaseRanges.getByName("MyName") 
set oDescriptor = oRange.getFilterDescriptor
oSheet = ThisComponent.createInstance ("com.sun.star.sheet.Spreadsheet")
ThisComponent.Sheets.insertByName ("Столовая для персонала", oSheet)
oCellAddress = ThisComponent.Sheets (1).getCellByPosition(0, 0).getCellAddress()
oFD = oRange.getFilterDescriptor()
With oFD
.CopyOutputData  = True
.OutputPosition = (oCellAddress)
End With
oField = createUnoStruct("com.sun.star.sheet.TableFilterField")
With oField
  .Field = 3
  .Operator = com.sun.star.sheet.FilterOperator.EQUAL
  .StringValue = "Столовая для персонала"
  End With
oFD.setFilterFields(Array(oField))
oRange.refresh()
'Удаляем ненужный нам лист Sheet1
oSheet = ThisComponent.createInstance ("com.sun.star.sheet.Spreadsheet")
ThisComponent.Sheets.removeByName ("Sheet1", oSheet)
'Удаляем ненужные в отчете столбцы
oSheet = ThisComponent.Sheets (0)
oRangeAddress = oSheet.getCellRangeByName("A1:A65536").getRangeAddress()
oSheet.removeRange(oRangeAddress,  com.sun.star.sheet.CellDeleteMode.LEFT)
oSheet = ThisComponent.Sheets (0)
oRangeAddress = oSheet.getCellRangeByName("C1:Z65536").getRangeAddress()
oSheet.removeRange(oRangeAddress,  com.sun.star.sheet.CellDeleteMode.LEFT)
oSheet = ThisComponent.Sheets (0)
oRangeAddress = oSheet.getCellRangeByName("H1:K65536").getRangeAddress()
oSheet.removeRange(oRangeAddress,  com.sun.star.sheet.CellDeleteMode.LEFT)
'Вызываем макрос Raschet_NDS (см. ниже)
Raschet_NDS
' Вызываем макрос Podstan1 (см. ниже)
Podstan1
' Устанавливаем на полученный диапазон формат два знака после запятой
ThisComponent.Sheets (0).getCellRangeByName("C2:H65535").NumberFormat=2
'Вставляем две пустые строки сверху (отступ)
ThisComponent.Sheets (0).ROWs.insertByIndex(0,1)
ThisComponent.Sheets (0).ROWs.insertByIndex(0,1)
'Выделяем первую верхнюю ячейку полученного нами диапазона
  oCell = ThisComponent.Sheets (0).getCellByPosition(0, 2)
ThisComponent.CurrentController.Select(oCell)
' вызываем макрос Oformlenie (см. ниже)
Oformlenie
'Сбрасываем выделение диапазона, выделением первой ячейки на листе
  oCell = ThisComponent.Sheets (0).getCellByPosition(0, 0)
ThisComponent.CurrentController.Select(oCell)
'Устанавливаем оптимальную ширину столбцов
For I = 0 To 9
Columns = ThisComponent.Sheets (0).Columns(I)
Columns.OptimalWidth = True
Next I
' Выводим в ячейку А1  ГМ и текущую дату
'Текущая дата всегда вызывается функцией DateValue(Now)
 ThisComponent.Sheets (0).getCellByPosition(0, 0).String = "ГМ " & " по " & DateValue(Now)
' вызываем макрос Cveta3 (см. ниже)
 Cveta3
End Sub

Sub Raschet_NDS
odoc=thiscomponent
oSheet = ThisComponent.Sheets(0)
oCellCursor = oSheet.createCursor()
oCellCursor.GotoStartOfUsedArea(True)
oCellCursor.GotoEndOfUsedArea(True)
Start_Row = oCellCursor.getRangeAddress.StartRow
End_Row = oCellCursor.getRangeAddress.EndRow
'Определяем необходимые ячейки, участвующие в расчете
'Сумма комплекса с НДС будет равна кратному от деления столбцов НДС18/СписСтол
' Плюс СтолСеб
currcell = osheet.getcellbyposition(7, End_Row)
currcell2 = osheet.getcellbyposition(2, End_Row)
currcell5 = osheet.getcellbyposition(5, End_Row)
currcell3 = osheet.getcellbyposition(3, End_Row)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv2 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = currcell2.getCellAddress
oConv5 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv5.Address = currcell5.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
'Сама формула расчета
 Podstanovka  = "=(" & oConv5.UserInterfaceRepresentation & "/" & oConv2.UserInterfaceRepresentation &")+" & oConv3.UserInterfaceRepresentation
 currcell.setFormula (Podstanovka)
 odoc.getCurrentController().Select(currcell)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:FillUp", "", 0, Array())
   oSheet = ThisComponent.createInstance ("com.sun.star.sheet.Spreadsheet")
'Делаем заголовок для 8-го столбца с нужной нам строчкой
   ThisComponent.Sheets (0).getCellByPosition(7, 0).String = "СтолСебсНДС"
   End Sub
   
   Sub Podstan1
'Макрос Podstan1 целиком отвечает за подбитие итогов столбцов
'Просмотрите внимательно этот код, чтобы понять к каких столбцах идет простое суммирование, в каких другая операция. Почему там применяется другая операция)
oCell = ThisComponent.Sheets (0).getCellByPosition(0, 0)
ThisComponent.CurrentController.Select(oCell)
odoc=thiscomponent
oSheet = ThisComponent.Sheets(0)
oCellCursor = oSheet.createCursor()
oCellCursor.GotoStartOfUsedArea(True)
oCellCursor.GotoEndOfUsedArea(True)
Start_Row = oCellCursor.getRangeAddress.StartRow
End_Row = oCellCursor.getRangeAddress.EndRow
currcell = osheet.getcellbyposition(2, End_Row+1)
currcell2 = osheet.getcellbyposition(2, Start_Row+1)
currcell3 = osheet.getcellbyposition(2, End_Row)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv2 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = currcell2.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
 Podstanovka  = "=SUM(" & oConv2.UserInterfaceRepresentation & ":" & oConv3.UserInterfaceRepresentation & ")"
 currcell.setFormula (Podstanovka)
 currcell = osheet.getcellbyposition(4, End_Row+1)
currcell2 = osheet.getcellbyposition(4, Start_Row+1)
currcell3 = osheet.getcellbyposition(4, End_Row)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv2 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = currcell2.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
 Podstanovka  = "=SUM(" & oConv2.UserInterfaceRepresentation & ":" & oConv3.UserInterfaceRepresentation & ")"
 currcell.setFormula (Podstanovka)
 'Расчет средней себеcтоимости
  currcell = osheet.getcellbyposition(3, End_Row+1)
currcell2 = osheet.getcellbyposition(4, End_Row+1)
currcell3 = osheet.getcellbyposition(2, End_Row+1)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv2 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = currcell2.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
 Podstanovka  = "=(" & oConv2.UserInterfaceRepresentation & "/" & oConv3.UserInterfaceRepresentation & ")"
 currcell.setFormula (Podstanovka)
  currcell = osheet.getcellbyposition(6, End_Row+1)
currcell2 = osheet.getcellbyposition(6, Start_Row+1)
currcell3 = osheet.getcellbyposition(6, End_Row)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv2 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = currcell2.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
 Podstanovka  = "=SUM(" & oConv2.UserInterfaceRepresentation & ":" & oConv3.UserInterfaceRepresentation & ")"
 currcell.setFormula (Podstanovka)
  currcell = osheet.getcellbyposition(7, End_Row+1)
currcell2 = osheet.getcellbyposition(6, End_Row+1)
currcell3 = osheet.getcellbyposition(2, End_Row+1)
oConv = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = currcell.getCellAddress
oConv2 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = currcell2.getCellAddress
oConv3 = thiscomponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv3.Address = currcell3.getCellAddress
 Podstanovka  = "=(" & oConv2.UserInterfaceRepresentation & "/" & oConv3.UserInterfaceRepresentation & ")"
 currcell.setFormula (Podstanovka)
 'Данные строчки делают шрифт жирным в первом и последнем столбцах таблицы 
' Это стандартная функция, когда мы хотим выделить итоговую строку
 ThisComponent.Sheets(0).getRows().getByIndex( 0 ).CharWeight = com.sun.star.awt.FontWeight.BOLD
 ThisComponent.Sheets(0).getRows().getByIndex(End_Row+1).CharWeight = com.sun.star.awt.FontWeight.BOLD
 End Sub


sub Oformlenie
'Данный макрос убирает формулы из таблицы, а также добавляет границ ячеек, чтобы 
'таблица смотрелась удобно. В основном коде мы уже встали на 1-ю левую верхнюю ячейку
'макрос выделит диапазон до конца и уберет не нужные флаги
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Sel"
args1(0).Value = true
dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
dim args3(5) as new com.sun.star.beans.PropertyValue
args3(0).Name = "Flags"
args3(0).Value = "SV"
args3(1).Name = "FormulaCommand"
args3(1).Value = 0
args3(2).Name = "SkipEmptyCells"
args3(2).Value = false
args3(3).Name = "Transpose"
args3(3).Value = false
args3(4).Name = "AsLink"
args3(4).Value = false
args3(5).Name = "MoveMode"
args3(5).Value = 4
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args3())
'Данная часть кода отвечает за заливку границ ячеек (стандартный код)
dim args4(12) as new com.sun.star.beans.PropertyValue
args4(0).Name = "OuterBorder.LeftBorder"
args4(0).Value = Array(0,0,2,0)
args4(1).Name = "OuterBorder.LeftDistance"
args4(1).Value = 0
args4(2).Name = "OuterBorder.RightBorder"
args4(2).Value = Array(0,0,2,0)
args4(3).Name = "OuterBorder.RightDistance"
args4(3).Value = 0
args4(4).Name = "OuterBorder.TopBorder"
args4(4).Value = Array(0,0,2,0)
args4(5).Name = "OuterBorder.TopDistance"
args4(5).Value = 0
args4(6).Name = "OuterBorder.BottomBorder"
args4(6).Value = Array(0,0,2,0)
args4(7).Name = "OuterBorder.BottomDistance"
args4(7).Value = 0
args4(8).Name = "InnerBorder.Horizontal"
args4(8).Value = Array(0,0,2,0)
args4(9).Name = "InnerBorder.Vertical"
args4(9).Value = Array(0,0,2,0)
args4(10).Name = "InnerBorder.Flags"
args4(10).Value = 0
args4(11).Name = "InnerBorder.ValidFlags"
args4(11).Value = 127
args4(12).Name = "InnerBorder.DefaultDistance"
args4(12).Value = 0
dispatcher.executeDispatch(document, ".uno:SetBorderStyle", "", 0, args4())
end sub

Sub Cveta3
'Макрос Cveta3 c помошью цикла for to next проверяет числовые значения в столбце 4
'Если себестоимость комплекса выше 38.14 - ячейка подсвечивается ярко красным цветом
oCell = ThisComponent.Sheets (0).getCellByPosition(0, 0)
ThisComponent.CurrentController.Select(oCell)
 oSheet = ThisComponent.CurrentController.getActiveSheet()
 myrows=oSheet.getrows
 oCellCursor = oSheet.createCursor()
 oCellCursor.GotoStartOfUsedArea(True)
 oCellCursor.GotoEndOfUsedArea(True)
'Поскольку в главном макросе мы уже сделали отступ в две строки отсчет первой ячейки 
' ведем с StarRow+3, т.е. наш диапазон без заголовка
 Start_Row = oCellCursor.getRangeAddress.StartRow+3
 End_Row = oCellCursor.getRangeAddress.EndRow + 1
 For i=End_Row To Start_Row step -1
'Указываем столбец в котором ищем значение
  text1 = osheet.getcellbyposition(3,i).Value
'Указывает что text1 должен быть больше 38.14
   If text1 > 38.14 Then
'Применяем к таким найденным ячейкам светло-красный цвет.
'За это отвечает код 16764057 функции CellBackColor (стандартно)
    oSheet.getCellByPosition (3,i).CellBackColor = 16764057
   End if   
   Next i
End Sub

После записи макроса закрываем окно разработки. В файле вновь жмем ALT+F11, находим модуль Stolov. В окне существующие макросы выделяем Stolov и жмем выполнить.
Как создавать меню, установочные файлы и прикреплять меню к макросам рассмотрим позже. Сейчас все создаваемые макросы вызываем напрямую через это окно.
также рекомендуется хранить коды создаваемых макросов в отдельных текстовых файлах, чтобы в случае сбоя ООО быстро восстановить потери.

Задание: 
а) проследите многократным нажатием клавиш отмены CTRL+Z все этапы работы макроса.
б) Закройте и откройте файл без сохранения - внесите намеренную ошибку - себестоимость комплекса свыше указанного числа, проверьте как обработчик справился с ошибкой.
Функция Exit Sub часто применяется для отладки макроса поэтапно - она вставляется в любую строчку кода главного макроса и прекращает выполнение последующего кода.
Поэкспериментируйте с функцией Exit Sub в главном созданном макросе, напишите эту строчку ее после следующих строк и выполните макрос:
oRange.refresh()
затем удалив и перенеся перед
Raschet_NDS
затем удалив и перенеся перед
Podstan1
затем удалив и перенеся перед
Ofomlenie