БЛАНКСШАБЛОНОМ [29.12.2007] "Процедуры и функции для работы с MS Excel";

var Buf[] :String;

-- КОНСТАНТЫ
var xlPortrait              :Integer=1;     -- "Портретная" ориентация печати
var xlLandscape             :Integer=2;     -- "Альбомная" ориентация печати
var xlDownThenOver          :Integer=1;     -- направление печати вниз затем вправо
var xlOverThenDown          :Integer=2;     -- направление печати вправо затем вниз

var xlDiagonalDown          :Integer=5;     -- Borders - граница: диагональ сверху вниз
var xlDiagonalUp            :Integer=6;     -- Borders - граница: диагональ снизу вверх
var xlEdgeLeft              :Integer=7;     -- Borders - граница: левая
var xlEdgeTop               :Integer=8;     -- Borders - граница: верхняя
var xlEdgeBottom            :Integer=9;     -- Borders - граница: нижняя
var xlEdgeRight             :Integer=10;    -- Borders - граница: правая
var xlInsideVertical        :Integer=11;    -- Borders - граница: внутренняя вертикальная
var xlInsideHorizontal      :Integer=12;    -- Borders - граница: внутренняя горизонтальная

var xlUnderlineStyleSingle           :Integer=2;     -- Подчеркивание - одиночное по значению
var xlUnderlineStyleDouble           :Integer=-4119; -- Подчеркивание - двойное   по значению
var xlUnderlineStyleSingleAccounting :Integer=4;     -- Подчеркивание - одиночное по ячейке
var xlUnderlineStyleDoubleAccounting :Integer=5;     -- Подчеркивание - двойное   по ячейке
var xlUnderlineStyleNone             :Integer=-4142; -- Подчеркивание - нет

var xlContinuous            :Integer=1;     -- LineStyle - сплошная
var xlDash                  :Integer=-4115; -- LineStyle - прерывистая тире (+ xlMedium - толстая) (+ xlThin - тонкая)
var xlDot                   :Integer=-4118; -- LineStyle - прерывистая точками (xlThin)
var xlDouble                :Integer=-4119; -- LineStyle - сплошная двойная (xlThick)
var xlDashDot               :Integer=4;     -- LineStyle - прерывистая: тире точка (+ xlMedium - толстая) (+ xlThin - тонкая)
var xlDashDotDot            :Integer=5;     -- LineStyle - прерывистая: тире две точки (+ xlMedium - толстая) (+ xlThin - тонкая)
var xlSlantDashDot          :Integer=13;    -- LineStyle - сплошная с двумя штрихами (+ xlMedium - толстая) (+ xlThin - тонкая)

var xlHairline              :Integer=1;     -- Weight - Толщина: тонкая точками
var xlThin                  :Integer=2;     -- Weight - Толщина: тонкая
var xlMedium                :Integer=-4138; -- Weight - Толщина: средняя
var xlThick                 :Integer=4;     -- Weight - Толщина: толстая

var xlGeneral               :Integer=1;     -- HorizontalAlignment: по значению
var xlLeft                  :Integer=-4131; -- HorizontalAlignment: по левому краю (отступ) {свойство IndentLevel}
var xlRight                 :Integer=-4152; -- HorizontalAlignment: по правому краю (отступ) {свойство IndentLevel}
var xlCenter                :Integer=-4108; -- HorizontalAlignment: по центру
var xlFill                  :Integer=5;     -- HorizontalAlignment: с заполнением (повторяющийся текст)
var xlJustify               :Integer=-4130; -- HorizontalAlignment: по ширине
var xlCenterAcrossSelection :Integer=7;     -- HorizontalAlignment: по центру выделения
var xlDistributed           :Integer=-4117; -- HorizontalAlignment: распределенный (отступ) {свойство IndentLevel}

var xlTop                   :Integer=-4160; -- VerticalAlignment: по верхнему краю
var xlBottom                :Integer=-4107; -- VerticalAlignment: по нижнему краю
--xlCenter, xlJustify, xlDistributed        -- VerticalAlignment: по центру - как и HorizontalAlignment

var xlVertical              :Integer=-4166; -- Orientation: вертикальнйы текст, или число от 1 до 90 поворот текста вверх (если с минусом, то вниз)
var xlSolid                 :Integer=1;     -- Pattern - заливка сплошная
var xlAutomatic             :Integer=-4105;
var xlNone                  :Integer=-4142; -- нет аттрибута

var xlColorBlack            :Integer=0;
var xlColorWhite            :Integer=16777215;

var xlDecimalSeparator      :Integer=3;
var xlThousandsSeparator    :Integer=4;
var msoLanguageIDUI         :Integer=2;

var xlA1                    :Integer=1;     -- Стиль ссылок буквенный
var xlR1C1                  :Integer=-4150; -- Стиль ссылок относительный

var xlExcel7      :Integer=39; --Формат файла Excel 7
var xlExcel9795   :Integer=43; --Формат файла Excel 95-97
var xlExcel8      :Integer=56; --Формат файла Excel 8

-- ПРОЦЕДУРЫ И ФУНКЦИИ

Proc УстановитьШиринуСтолбцаСимвол(objSheet:AutoObject; NumCol:Integer; valW:Numeric);
-- * УСТАНАВЛИВАЕМ ШИРИНУ СТОЛБЦА В ЕД.ИЗМ. САМОГО EXCEL'А (В СИМВОЛАХ "СТАНДАРТНОГО ШРИФТА") *
-- objSheet - ссылка на лист
-- NumCol   - порядковый номер столбца в листе objSheet
-- valW     - значение ширины в символах "стандартного шрифта"
var xlsColumn :AutoObject;
 xlsColumn=AsAutoObject(objSheet.Columns[NumCol]);
 Try
   xlsColumn.ColumnWidth=valW;
 Finally
   ClearVariable(xlsColumn);
 end;
end;

Proc УстановитьШиринуСтолбцаММAvg(objSheet:AutoObject; NumCol:Integer; ммVal:Numeric; maxColumn:Integer; UserПоправка:Integer);
-- * УСТАНАВЛИВАЕМ ШИРИНУ СТОЛБЦА В ММ *
-- поправка ширины рассчитывается от количества столбцов
-- objSheet     - ссылка на лист
-- NumCol       - порядковый номер столбца в листе objSheet
-- ммVal        - значение ширины в мм.
-- maxColumn    - столбцов в таблице
-- UserПоправка - коэффициент поправки пользователя
var пунктVal, символVal, ммValпункт, поправкаVal, Res, sum :Numeric;
var xlsColumn :AutoObject;
 Res=0.00;
 xlsColumn=AsAutoObject(objSheet.Columns[NumCol]);
 Try
   -- переводим милимметры в пункты (стандарт Adobe 1/72 дюйма - для обычного шрифта (96 точек на дюйм))
   ммValпункт = 72*ммVal/25.4;
   -- стандартная ширина колонки Excel в пунктах
     пунктVal = AsReal(xlsColumn.Width);
   -- стандартная ширина колонки Excel в символах "стандартного шрифта"
    символVal = AsReal(xlsColumn.ColumnWidth);
   -- вычисляем пропорцию и возвращаем требуемые миллиметры
          sum = символVal*ммValпункт/пунктVal;
  поправкаVal = maxColumn*2/30*UserПоправка;
          Res = if((sum-поправкаVal)>1.00, sum-поправкаVal, sum);
   xlsColumn.ColumnWidth=Res;
 Finally
   ClearVariable(xlsColumn);
 end;
end;

Proc УстановитьШиринуСтолбцаММ(objSheet:AutoObject; NumCol:Integer; ммVal:Numeric; поправкаVal:Numeric);
-- * УСТАНАВЛИВАЕМ ШИРИНУ СТОЛБЦА В ММ *
-- objSheet    - ссылка на лист
-- NumCol      - порядковый номер столбца в листе objSheet
-- ммVal       - значение ширины в мм.
-- поправкаVal - (в десятых долях коэффициента поправки пользователя)
-- поправка на разрешение экрана (если нужно) - для стандартного монитра LCD 1280x1024 c обычным шрифтом (96 точек на дюйм) это примерно 0.3 символа стандартного шрифта
var пунктVal, символVal, ммValпункт, Res, sum :Numeric;
var xlsColumn :AutoObject;
 Res=0.00;
 xlsColumn=AsAutoObject(objSheet.Columns[NumCol]);
 Try
   -- переводим милимметры в пункты (стандарт Adobe 1/72 дюйма - для обычного шрифта (96 точек на дюйм))
   ммValпункт = 72*ммVal/25.4;
   -- стандартная ширина колонки Excel в пунктах
     пунктVal = AsReal(xlsColumn.Width);
   -- стандартная ширина колонки Excel в символах "стандартного шрифта"
    символVal = AsReal(xlsColumn.ColumnWidth);
   -- вычисляем пропорцию и возвращаем требуемые миллиметры
          sum = символVal*ммValпункт/пунктVal;
          Res = if((sum-поправкаVal)>1.00, sum-поправкаVal, sum);
   xlsColumn.ColumnWidth=Res;
 Finally
   ClearVariable(xlsColumn);
 end;
end;

Proc НарисоватьГраницуЯчейки(objSheet:AutoObject; Border:Integer; Weight:Integer; X:Integer; Y:Integer);
-- * НАРИСОВАТЬ ЭЛЕМЕНТ ГРАНИЦЫ ЯЧЕЙКИ *
-- Это упрощенный вариант, применение нежелательно
-- objSheet    - ссылка на лист
-- Border      - элемент границы (константа Excel)
-- Weight      - толщина границы (константа Excel)
-- X, Y        - координаты ячейки листа objSheet
var xlsRange, xlsBorder :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsBorder=AsAutoObject(xlsRange.Borders[Border]);
   Try
     xlsBorder.Weight=Weight;
   Finally
     ClearVariable(xlsBorder);
   end;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc УстановитьТекстЯчейки(objSheet:AutoObject; X:Integer; Y:Integer; Text:String; FontSize:Integer; Bold:Logical; Alignment:Integer);
-- * ЗАПИСАТЬ ЗНАЧЕНИЕ в ЯЧЕЙКУ КАК ТЕКСТ *
-- Это упрощенный вариант, применение нежелательно
-- objSheet    - ссылка на лист
-- X, Y        - координаты ячейки листа objSheet
-- Text        - значение, которое надо записать как текст
-- FontSize    - размер шрифта
-- Bold        - жирность
-- Alignment   - выравнивание
var xlsRange, xlsFont :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsRange.Value=Text;
   xlsRange.HorizontalAlignment=Alignment;
   xlsFont=AsAutoObject(xlsRange.Font);
   Try
     xlsFont.Bold=Bold;
     xlsFont.Size=FontSize;
   Finally
     ClearVariable(xlsFont);
   end;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Func ЧислоСтандартаRusExcel(Chislo:String) :String;
-- * ЗАМЕНИТЬ В СТРОКОВОМ ЧИСЛЕ, ТОЧКУ НА ЗАПЯТУЮ *
-- Это устаревший вариант, применение нежелательно
var len, ii :Integer;
var Chars, Res :String;
 Res="";
 len=Length(Chislo);
 if len>0:
   for ii=1 to len do
     Chars=SubStr(Chislo, ii, 1);
     if Chars>="0" and Chars<="9": Res=Res+Chars;
     |  Chars>="."               : Res=Res+",";
     fi;
   od;
 fi;
 ^Res;
end;

Func ФорматированнаяСумма_Число(Chislo:String) :Numeric;
-- * CЧИТАННУЮ ИЗ СЕКЦИИ ТУРБО СТРОКУ С ЧИСЛОМ ПРЕОБРАЗУЕМ В ЧИСЛО *
-- применяются символы: только цифры и точка
var len, ii :Integer;
var Chars, fmtStr :String;
var Res :Numeric;
 Res=0.00;
 fmtStr="";
 len=Length(Chislo);
 if len>0 and Chislo<>"X" and Chislo<>Chr(151):
   for ii=1 to len do
     Chars=SubStr(Chislo, ii, 1);
     if (Ascii(Chars)>47 and Ascii(Chars)<58) or Ascii(Chars)=46: fmtStr=fmtStr+Chars; fi;
   od;
 fi;
 if fmtStr<>"": Try Res=StringToNumeric(fmtStr); Except end; fi;
 ^Res;
end;

Func ЗаменитьEnter_Old(SrcString:String) :String;
-- перевода строки в Excel chr(10), а в ТУРБО chr(13) -> в данной функции строка ТБ с chr(13) переводится в соответствующую с chr(10)
var Res, codAscii : String;
var len, ii :Integer;
 Res="";
 len=Length(SrcString);
 if len>0:
   for ii=1 to len do
     codAscii=SubStr(SrcString, ii, 1);
     if Ascii(codAscii)=13: Res=Res+Chr(10); else Res=Res+codAscii; fi;
   od;
 fi;
 ^Res;
end;

Func ЗаменитьСимволСтрокиВпозиции(valStr:String; repChar:String; repPos:Integer) :String;
var tmpFirst, tmpLast, out :String;
var len :Integer;
 tmpFirst=""; tmpLast=""; out="";
 len=Length(valStr);
 if repPos<1: repPos=1; fi;
 if repPos>len or repChar="" or valStr="": ^valStr; fi;
 repChar=SubStr(repChar, 1, 1);
 if repPos>1: tmpFirst=SubStr(valStr, 1, repPos-1); else tmpFirst=""; fi;
 if repPos<len: tmpLast=SubStr(valStr, repPos+1, len-repPos); else tmpLast=""; fi;
 out=tmpFirst+repChar+tmpLast;
 ^out;
end;

Func ЗаменитьEnter(srcString:String) :String;
-- перевода строки в Excel chr(10), а в ТУРБО chr(13) -> в данной функции строка ТБ с chr(13) переводится в соответствующую с chr(10)
var pp :Integer;
 pp=Pos(Chr(13), srcString);
 while pp>0 do srcString=ЗаменитьСимволСтрокиВпозиции(srcString, Chr(10), pp); pp=Pos(Chr(13), srcString); od;
 ^srcString;
end;

Func УбратьEnter(SrcString:String) :String;
-- в данной функции из строка ТБ убирается символ chr(13)
var Res, codAscii : String;
var len, ii :Integer;
 Res="";
 len=Length(SrcString);
 if len>0:
   for ii=1 to len do
     codAscii=SubStr(SrcString, ii, 1);
     if Ascii(codAscii)<>13: Res=Res+codAscii; fi;
   od;
 fi;
 ^Res;
end;

Proc ОбъединитьЯчейкиДиапазона(objSheet:AutoObject; X1:Integer; Y1:Integer; X2:Integer; Y2:Integer);
var xlsRange1, xlsRange2, xlsRangeRes :AutoObject;
-- * ОБЪЕДИНИТЬ ЯЧЕЙКИ ДИАПАЗОНА *
-- objSheet    - ссылка на лист
-- X1, Y1      - координаты ячейки листа objSheet - левый верхний угол диапазона для объединения
-- X2, Y2      - координаты ячейки листа objSheet - правый нижний угол диапазона для объединения
 if X1>0 and X2>0 and Y1>0 and Y2>0 and X2>=X1 and Y2>=Y1:
   xlsRange1=AsAutoObject(objSheet.Cells[X1,Y1]);
   xlsRange2=AsAutoObject(objSheet.Cells[X2,Y2]);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange1, xlsRange2]);
     Try
       xlsRangeRes.Merge(False);
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsRange1);
     ClearVariable(xlsRange2);
   end;
 fi;
end;

Proc ФорматироватьЯчейку(objSheet:AutoObject; X:Integer; Y:Integer; HAlign:Integer; lvlIndent:Integer; VAlign:Integer; txtWrap:Logical; FontFamily:String; FontSize:Integer; FontColor:Integer; AutoFontColor:Logical; FontBold:Logical; FontItalic:Logical; CellColor:Integer; NoCellColor:Logical);
-- * ФОРМАТИРОВАТЬ ЯЧЕЙКУ (УСТАНОВИТЬ СТИЛЬ) *
-- Основная процедура для форматирования ячейки
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- HAlign        - горизонтальное выравнивание ячейки (константа Excel)
-- lvlIndent     - отступ текста от края ячейки
-- VAlign        - вертикальное выравнивание ячейки (константа Excel)
-- txtWrap       - автопернос слов в ячейки
-- FontFamily    - Название установленного в Windows шрифта TTF
-- FontSize      - размер шрифта
-- FontColor     - цвет шрифта (константа Excel)
-- AutoFontColor - цвет шрифта определяется автоматически (параметр FontColor игнорируется)
-- FontBold      - жирность шрифта (да/нет)
-- FontItalic    - курсив шрифта   (да/нет)
-- CellColor     - цвет ячейки (константа Excel) - заливка цветом всегда сплошная (xlSolid)
-- NoCellColor   - цвет ячейки по умолчанию (параметр CellColor игнорируется)
var xlsRange, xlsFont :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsRange.HorizontalAlignment = HAlign;
   xlsRange.VerticalAlignment   = VAlign;
   xlsRange.WrapText = txtWrap;
   xlsRange.IndentLevel = lvlIndent;
   xlsFont=AsAutoObject(xlsRange.Font);
   Try
     xlsFont.Name  = FontFamily;
     xlsFont.Size  = FontSize;
     if AutoFontColor: xlsFont.ColorIndex = РАБ.EXCEL.xlAutomatic; else xlsFont.Color = FontColor; fi;
     xlsFont.Bold   = FontBold;
     xlsFont.Italic = FontItalic;
   Finally
     ClearVariable(xlsFont);
   end;
   xlsFont=AsAutoObject(xlsRange.Interior);
   Try
     xlsFont.Pattern = РАБ.EXCEL.xlSolid;
     if NoCellColor: 
       xlsFont.ColorIndex = РАБ.EXCEL.xlNone;
       xlsFont.PatternColorIndex = РАБ.EXCEL.xlNone;
     else
       xlsFont.Color = CellColor; 
       xlsFont.PatternColorIndex = РАБ.EXCEL.xlAutomatic;
     fi;
   Finally
     ClearVariable(xlsFont);
   end;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc ЗаписатьЯчейкуЧисло(objSheet:AutoObject; X:Integer; Y:Integer; tbValue:Numeric; locDS:String; locTS:String);
-- * ЗАПИСАТЬ ЧИСЛО В ЯЧЕЙКУ *
-- Основная процедура для записи ЧИСЛА в ячейку
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbValue       - число для записи
-- locDS         - локальный разделитель дробной части
-- locTS         - локальный разделитель тысяч
-- locDS и locTS заранее необходимо узнать и передать в функцию, например так:
-- xlsApp=CreateAutoObject('Excel.Application');
-- Try
--   localDS=asString(xlsApp.International[РАБ.EXCEL.xlDecimalSeparator]);
--   localTS=asString(xlsApp.International[РАБ.EXCEL.xlThousandsSeparator]);
--   --xlDecimalSeparator и xlThousandsSeparator константы EXCEL
--   ... передаем в функцию
-- Except
--   ClearVariable(xlsApp);
-- end;
var xlsRange :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsRange.NumberFormat = "#"+locTS+"##0"+locDS+"00"; -- "# ##0,00"
   xlsRange.Value2 = tbValue;
   --xlsRange.Formula = tbValue;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc ЗаписатьЯчейкуЧислоПлюсМинус(objSheet:AutoObject; X:Integer; Y:Integer; tbValue:Numeric; locDS:String; locTS:String);
-- * ЗАПИСАТЬ ЧИСЛО В ЯЧЕЙКУ *
-- Основная процедура для записи ЧИСЛА в ячейку
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbValue       - число для записи
-- locDS         - локальный разделитель дробной части
-- locTS         - локальный разделитель тысяч
-- locDS и locTS заранее необходимо узнать и передать в функцию, например так:
-- xlsApp=CreateAutoObject('Excel.Application');
-- Try
--   localDS=asString(xlsApp.International[РАБ.EXCEL.xlDecimalSeparator]);
--   localTS=asString(xlsApp.International[РАБ.EXCEL.xlThousandsSeparator]);
--   --xlDecimalSeparator и xlThousandsSeparator константы EXCEL
--   ... передаем в функцию
-- Except
--   ClearVariable(xlsApp);
-- end;
var xlsRange :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsRange.NumberFormat = "+#"+locTS+"##0"+locDS+"00;-#"+locTS+"##0"+locDS+"00"; -- "+#,##0.00;-#,##0.00"
   xlsRange.Value2 = tbValue;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Func СейчасСтильСсылокR1C1(objApp:AutoObject) :Logical;
 if asInteger(objApp.ReferenceStyle)=РАБ.EXCEL.xlR1C1: ^True; else ^False; fi;
end;

Proc УстановитьСтильСсылокR1C1(objApp:AutoObject; Разрешить:Logical);
 objApp.ReferenceStyle = if(Разрешить, РАБ.EXCEL.xlR1C1, РАБ.EXCEL.xlA1);
end;

Proc ЗаписатьЯчейкуИтогоКолонки(objApp:AutoObject; objSheet:AutoObject; XX:Integer; YY:Integer; R1:Integer; RN:Integer; flgRusExcel:Logical; flgUseR1C1:Logical);
-- * ЗАПИСАТЬ В ЯЧЕЙКУ СУММУ ИТОГО ПО КОЛОНКЕ (аналог автосуммирования Excel)*
-- objApp   - ссылка на экземпляр EXCEL'а
-- objSheet - ссылка на лист
-- XX, YY   - координаты ячейки листа objSheet куда записываем итог
-- R1       - количество ячеек до первой    ячейки диапазона суммирования
-- RN       - количество ячеек до последней ячейки диапазона суммирования
var xlsRange :AutoObject;
 if R1>=RN:
   if not flgUseR1C1: РАБ.EXCEL.УстановитьСтильСсылокR1C1(objApp, True); fi;
   xlsRange=AsAutoObject(objSheet.Cells[XX,YY]);
   Try
     if flgRusExcel:
       xlsRange.FormulaR1C1Local = '=СУММ(R[-'+Str(R1)+']C:R[-'+Str(RN)+']C)';
     else
       xlsRange.FormulaR1C1      =  '=SUM(R[-'+Str(R1)+']C:R[-'+Str(RN)+']C)';
     fi;
   Finally
     ClearVariable(xlsRange);
   end;
   if not flgUseR1C1: РАБ.EXCEL.УстановитьСтильСсылокR1C1(objApp, False); fi;
 fi;
end;

Proc ЗаписатьЯчейкуТекст(objSheet:AutoObject; X:Integer; Y:Integer; tbValue:String);
-- * ЗАПИСАТЬ ТЕКСТ В ЯЧЕЙКУ *
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbValue       - текст для записи
var xlsRange :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsRange.NumberFormat = "@";
   xlsRange.Value2 = tbValue;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc ЗаписатьЯчейкуДату(objSheet:AutoObject; X:Integer; Y:Integer; flgRusExcel:Logical; tbDate:Date; ПустаяДата:Logical);
-- * ЗАПИСАТЬ ДАТУ В ОБЫЧНОМ ФОРМАТЕ - ДД ММ ГГГГ *
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbDate        - дата
var xlsRange :AutoObject;
--ДД.ММ.ГГГГ;@
--dd/mm/yyyy;@
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   if flgRusExcel:
     xlsRange.NumberFormatLocal = 'ДД.ММ.ГГГГ';
   else
     xlsRange.NumberFormat      = 'DD/MM/YYYY';
   fi;
   if not ПустаяДата: xlsRange.Value2 = tbDate; fi;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc ЗаписатьЯчейкуДату_Г(objSheet:AutoObject; X:Integer; Y:Integer; flgRusExcel:Logical; tbDate:Date; ПустаяДата:Logical);
-- * ЗАПИСАТЬ ДАТУ В ОБЫЧНОМ ФОРМАТЕ - ДД ММ ГГГГ *
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbDate        - дата
var xlsRange :AutoObject;
--ДД.ММ.ГГГГ;@
--dd/mm/yyyy;@
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   if flgRusExcel:
     xlsRange.NumberFormatLocal = 'ДД.ММ.ГГГГ'+'"'+' г.'+'"';
   else
     xlsRange.NumberFormat      = 'DD/MM/YYYY'+'"'+' г.'+'"';
   fi;
   if not ПустаяДата: xlsRange.Value2 = tbDate; fi;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc ЗаписатьЯчейкуДату_Прописью(objSheet:AutoObject; X:Integer; Y:Integer; flgRusExcel:Logical; tbDate:Date; ПустаяДата:Logical);
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbDate        - дата
var xlsRange :AutoObject;
--"[$-F800]dddd, mmmm dd, yyyy"
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   if flgRusExcel:
     xlsRange.NumberFormatLocal = '[$-F800]ДДДД, ММММ ДД, ГГГГ';
   else
     xlsRange.NumberFormat      = '[$-F800]DDDD, MMMM DD, YYYY';
   fi;
   if not ПустаяДата: xlsRange.Value2 = tbDate; fi;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc ЗаписатьЯчейкуДатуКавычки(objSheet:AutoObject; X:Integer; Y:Integer; flgRusExcel:Logical; tbDate:Date; ПустаяДата:Logical);
-- * ЗАПИСАТЬ ДАТУ В ФОРМАТЕ - "ДД" ММММ ГГГГ г. *
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbDate        - дата
var xlsRange :AutoObject;
 -- Selection.NumberFormat = "[$-FC19]\""dd\"" mmmm yyyy ""г."""
 -- [$-FC19]\"ДД\" ММММ ГГГГ "г."
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   if flgRusExcel:
     xlsRange.NumberFormatLocal = '[$-FC19]\'+'"'+'ДД\'+'"'+' ММММ ГГГГ '+'"'+'г.'+'"';
   else
     xlsRange.NumberFormat      = '[$-FC19]\'+'"'+'DD\'+'"'+' MMMM YYYY '+'"'+'г.'+'"';
   fi;
   if not ПустаяДата: xlsRange.Value2 = tbDate; fi;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc ЗаписатьЯчейкуДатуМесяцГод(objSheet:AutoObject; X:Integer; Y:Integer; flgRusExcel:Logical; tbDate:Date; ПустаяДата:Logical);
-- * ЗАПИСАТЬ ДАТУ В ФОРМАТЕ - за ММММ ГГГГ г. *
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- tbDate        - дата
var xlsRange :AutoObject;
 -- [$-F419] за ММММ ГГГГ \г\.;@
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   if flgRusExcel:
     xlsRange.NumberFormatLocal = '[$-F419] за ММММ ГГГГ \г\.;@';
   else
     xlsRange.NumberFormat      = '[$-F419] за MMMM YYYY \г\.;@';
   fi;
   if not ПустаяДата: xlsRange.Value2 = tbDate; fi;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc УстановитьГраницуОднойЯчейки(objSheet:AutoObject; X:Integer; Y:Integer; типГраницы:Integer; lineСтиль:Integer; lineТолщина:Integer);
-- * УСТАНОВИТЬ ЭЛЕМЕНТ ГРАНИЦЫ В ОДНОЙ КОНКРЕТНОЙ ЯЧЕЙКЕ *
-- objSheet      - ссылка на лист
-- X, Y          - координаты ячейки листа objSheet
-- типГраницы    - элемент границы (граница верхняя, левая, и т.д.) (константа EXCEL)
-- lineСтиль     - стиль изображения границы (константа EXCEL)
-- lineТолщина   - толщина границы (константа EXCEL)
var xlsRange, xlsBorder :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsBorder=AsAutoObject(xlsRange.Borders[типГраницы]);
   Try
     xlsBorder.LineStyle = lineСтиль;
        xlsBorder.Weight = lineТолщина;
   Finally
     ClearVariable(xlsBorder);
   end;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc УстановитьГраницу(objRange:AutoObject; типГраницы:Integer; lineСтиль:Integer; lineТолщина:Integer);
-- * УСТАНОВИТЬ ЭЛЕМЕНТ ГРАНИЦЫ В ОДНОЙ КОНКРЕТНОЙ ЯЧЕЙКЕ *
-- основная вспомогательная процедура для установки конкретного элемента границы (верхнего, левого, и т.д.)
-- самостоятельно использовать можно, но не рекомендуется
-- objRange      - ссылка на ячейку
-- типГраницы    - элемент границы (граница верхняя, левая, и т.д.) (константа EXCEL)
-- lineСтиль     - стиль изображения границы (константа EXCEL)
-- lineТолщина   - толщина границы (константа EXCEL)
var xlsBorder :AutoObject;
 xlsBorder=AsAutoObject(objRange.Borders[типГраницы]);
 Try
   xlsBorder.LineStyle = lineСтиль;
   xlsBorder.Weight    = lineТолщина;
 Finally
   ClearVariable(xlsBorder);
 end;
end;

Proc СброситьГраницу(objRange:AutoObject; типГраницы:Integer);
-- * СБРОСИТЬ ЭЛЕМЕНТ ГРАНИЦЫ В ОДНОЙ КОНКРЕТНОЙ ЯЧЕЙКЕ *
-- основная вспомогательная процедура для сброса конкретного элемента границы (верхнего, левого, и т.д.)
-- самостоятельно использовать можно, но не рекомендуется
-- objRange      - ссылка на ячейку
-- типГраницы    - элемент границы (граница верхняя, левая, и т.д.) (константа EXCEL)
var xlsBorder :AutoObject;
 xlsBorder=AsAutoObject(objRange.Borders[типГраницы]);
 Try
   xlsBorder.LineStyle = РАБ.Excel.xlNone;
 Finally
   ClearVariable(xlsBorder);
 end;
end;

Proc УстановитьВсеГраницыОднойЯчейки(objSheet:AutoObject; X:Integer; Y:Integer; lineЛевая:Logical; lineВерхняя:Logical; lineПравая:Logical; lineНижняя:Logical; lineДиагональВверх:Logical; lineДиагональВниз:Logical; lineСтиль:Integer; lineТолщина:Integer);
-- * УСТАНОВИТЬ ВСЕ ОСНОВНЫЕ ГРАНИЦЫ В ОДНОЙ КОНКРЕТНОЙ ЯЧЕЙКЕ *
-- стиль и толщина для всех выбранных элементов границы будет одинаковым!
-- objSheet           - ссылка на лист
-- X, Y               - координаты ячейки листа objSheet
-- lineЛевая          - элемент границы(да/нет)
-- lineВерхняя        - элемент границы(да/нет)
-- lineПравая         - элемент границы(да/нет)
-- lineНижняя         - элемент границы(да/нет)
-- lineДиагональВверх - элемент границы(да/нет)
-- lineДиагональВниз  - элемент границы(да/нет)
-- lineСтиль          - стиль изображения границы (константа EXCEL)
-- lineТолщина        - толщина границы (константа EXCEL)
var xlsRange :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   if lineЛевая:          УстановитьГраницу(xlsRange, РАБ.EXCEL.xlEdgeLeft,     lineСтиль, lineТолщина); fi;
   if lineВерхняя:        УстановитьГраницу(xlsRange, РАБ.EXCEL.xlEdgeTop,      lineСтиль, lineТолщина); fi;
   if lineПравая:         УстановитьГраницу(xlsRange, РАБ.EXCEL.xlEdgeRight,    lineСтиль, lineТолщина); fi;
   if lineНижняя:         УстановитьГраницу(xlsRange, РАБ.EXCEL.xlEdgeBottom,   lineСтиль, lineТолщина); fi;
   if lineДиагональВверх: УстановитьГраницу(xlsRange, РАБ.EXCEL.xlDiagonalUp,   lineСтиль, lineТолщина); fi;
   if lineДиагональВниз:  УстановитьГраницу(xlsRange, РАБ.EXCEL.xlDiagonalDown, lineСтиль, lineТолщина); fi;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc УстановитьВсеГраницыДиапазона(objSheet:AutoObject; X1:Integer; Y1:Integer; X2:Integer; Y2:Integer; lineЛевая:Logical; lineВерхняя:Logical; lineПравая:Logical; lineНижняя:Logical; lineДиагональВверх:Logical; lineДиагональВниз:Logical; lineСтиль:Integer; lineТолщина:Integer);
-- * УСТАНОВИТЬ ВСЕ ВНЕШНИЕ ГРАНИЦЫ В ДИАПАЗОНЕ ЯЧЕЕК *
-- стиль и толщина для всех выбранных элементов границы будет одинаковым!
-- для рисования таблиц, предпочтительней пользоваться данной процедуры
-- т.е. задавать свойства границ лучше через диапазон ячеек (быстрее нарисуются)
-- objSheet           - ссылка на лист
-- X1, Y1             - координаты ячейки листа objSheet - левый верхний угол диапазона для объединения
-- X2, Y2             - координаты ячейки листа objSheet - правый нижний угол диапазона для объединения
-- lineЛевая          - элемент границы(да/нет)
-- lineВерхняя        - элемент границы(да/нет)
-- lineПравая         - элемент границы(да/нет)
-- lineНижняя         - элемент границы(да/нет)
-- lineДиагональВверх - элемент границы(да/нет)
-- lineДиагональВниз  - элемент границы(да/нет)
-- lineСтиль          - стиль изображения границы (константа EXCEL)
-- lineТолщина        - толщина границы (константа EXCEL)
var xlsRange1, xlsRange2, xlsRangeRes :AutoObject;
 if X1>0 and X2>0 and Y1>0 and Y2>0 and X2>=X1 and Y2>=Y1:
   xlsRange1=AsAutoObject(objSheet.Cells[X1,Y1]);
   xlsRange2=AsAutoObject(objSheet.Cells[X2,Y2]);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange1, xlsRange2]);
     Try
       if lineЛевая:          УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeLeft,     lineСтиль, lineТолщина); fi;
       if lineВерхняя:        УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeTop,      lineСтиль, lineТолщина); fi;
       if lineПравая:         УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeRight,    lineСтиль, lineТолщина); fi;
       if lineНижняя:         УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeBottom,   lineСтиль, lineТолщина); fi;
       if lineДиагональВверх: УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalUp,   lineСтиль, lineТолщина); fi;
       if lineДиагональВниз:  УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalDown, lineСтиль, lineТолщина); fi;
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsRange1);
     ClearVariable(xlsRange2);
   end;
 fi;
end;

Proc СброситьВсеГраницыДиапазона(objSheet:AutoObject; X1:Integer; Y1:Integer; X2:Integer; Y2:Integer; lineЛевая:Logical; lineВерхняя:Logical; lineПравая:Logical; lineНижняя:Logical; lineДиагональВверх:Logical; lineДиагональВниз:Logical);
-- * СБРОСИТЬ ВСЕ ВНЕШНИЕ ГРАНИЦЫ В ДИАПАЗОНЕ ЯЧЕЕК *
-- стиль и толщина для всех выбранных элементов границы будет одинаковым!
-- для рисования таблиц, предпочтительней пользоваться данной процедуры
-- т.е. задавать свойства границ лучше через диапазон ячеек (быстрее нарисуются)
-- objSheet           - ссылка на лист
-- X1, Y1             - координаты ячейки листа objSheet - левый верхний угол диапазона для объединения
-- X2, Y2             - координаты ячейки листа objSheet - правый нижний угол диапазона для объединения
-- lineЛевая          - элемент границы(да/нет)
-- lineВерхняя        - элемент границы(да/нет)
-- lineПравая         - элемент границы(да/нет)
-- lineНижняя         - элемент границы(да/нет)
-- lineДиагональВверх - элемент границы(да/нет)
-- lineДиагональВниз  - элемент границы(да/нет)
var xlsRange1, xlsRange2, xlsRangeRes :AutoObject;
 if X1>0 and X2>0 and Y1>0 and Y2>0 and X2>=X1 and Y2>=Y1:
   xlsRange1=AsAutoObject(objSheet.Cells[X1,Y1]);
   xlsRange2=AsAutoObject(objSheet.Cells[X2,Y2]);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange1, xlsRange2]);
     Try
       if lineЛевая:          СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeLeft     ); fi;
       if lineВерхняя:        СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeTop      ); fi;
       if lineПравая:         СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeRight    ); fi;
       if lineНижняя:         СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeBottom   ); fi;
       if lineДиагональВверх: СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalUp   ); fi;
       if lineДиагональВниз:  СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalDown ); fi;
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsRange1);
     ClearVariable(xlsRange2);
   end;
 fi;
end;

Proc СброситьВсеГраницыДиапазонаИвнутри(objSheet:AutoObject; X1:Integer; Y1:Integer; X2:Integer; Y2:Integer; lineЛевая:Logical; lineВерхняя:Logical; lineПравая:Logical; lineНижняя:Logical; lineВнутриВер:Logical; lineВнутриГор:Logical; lineДиагональВверх:Logical; lineДиагональВниз:Logical);
-- * СБРОСИТЬ ВСЕ ВНЕШНИЕ и ВНУТРЕННИЕ ГРАНИЦЫ В ДИАПАЗОНЕ ЯЧЕЕК *
-- стиль и толщина для всех выбранных элементов границы будет одинаковым!
-- для рисования таблиц, предпочтительней пользоваться данной процедуры
-- т.е. задавать свойства границ лучше через диапазон ячеек (быстрее нарисуются)
-- objSheet           - ссылка на лист
-- X1, Y1             - координаты ячейки листа objSheet - левый верхний угол диапазона для объединения
-- X2, Y2             - координаты ячейки листа objSheet - правый нижний угол диапазона для объединения
-- lineЛевая          - элемент границы(да/нет)
-- lineВерхняя        - элемент границы(да/нет)
-- lineПравая         - элемент границы(да/нет)
-- lineНижняя         - элемент границы(да/нет)
-- lineВнутриВер      - элемент границы(да/нет)
-- lineВнутриГор      - элемент границы(да/нет)
-- lineДиагональВверх - элемент границы(да/нет)
-- lineДиагональВниз  - элемент границы(да/нет)
var xlsRange1, xlsRange2, xlsRangeRes :AutoObject;
 if X1>0 and X2>0 and Y1>0 and Y2>0 and X2>=X1 and Y2>=Y1:
   xlsRange1=AsAutoObject(objSheet.Cells[X1,Y1]);
   xlsRange2=AsAutoObject(objSheet.Cells[X2,Y2]);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange1, xlsRange2]);
     Try
       if lineЛевая               : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeLeft         ); fi;
       if lineВерхняя             : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeTop          ); fi;
       if lineПравая              : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeRight        ); fi;
       if lineНижняя              : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeBottom       ); fi;
       if Y2>Y1 and lineВнутриВер : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlInsideVertical   ); fi;
       if X2>X1 and lineВнутриГор : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlInsideHorizontal ); fi;
       if lineДиагональВверх      : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalUp       ); fi;
       if lineДиагональВниз       : СброситьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalDown     ); fi;
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsRange1);
     ClearVariable(xlsRange2);
   end;
 fi;
end;

Proc УстановитьВсеГраницыДиапазонаИвнутри(objSheet:AutoObject; X1:Integer; Y1:Integer; X2:Integer; Y2:Integer; lineЛевая:Logical; lineВерхняя:Logical; lineПравая:Logical; lineНижняя:Logical; lineВнутриВер:Logical; lineВнутриГор:Logical; lineДиагональВверх:Logical; lineДиагональВниз:Logical; lineСтиль:Integer; lineТолщина:Integer);
-- * УСТАНОВИТЬ ВСЕ ВНЕШНИЕ + ВНУТРЕННИЕ ГРАНИЦЫ В ДИАПАЗОНЕ ЯЧЕЕК *
-- стиль и толщина для всех выбранных элементов границы будет одинаковым!
-- objSheet           - ссылка на лист
-- X1, Y1             - координаты ячейки листа objSheet - левый верхний угол диапазона для объединения
-- X2, Y2             - координаты ячейки листа objSheet - правый нижний угол диапазона для объединения
-- lineЛевая          - элемент границы(да/нет)
-- lineВерхняя        - элемент границы(да/нет)
-- lineПравая         - элемент границы(да/нет)
-- lineНижняя         - элемент границы(да/нет)
-- lineВнутриВер      - элемент границы(да/нет)
-- lineВнутриГор      - элемент границы(да/нет)
-- lineДиагональВверх - элемент границы(да/нет)
-- lineДиагональВниз  - элемент границы(да/нет)
-- lineСтиль          - стиль изображения границы (константа EXCEL)
-- lineТолщина        - толщина границы (константа EXCEL)
var xlsRange1, xlsRange2, xlsRangeRes :AutoObject;
 if X1>0 and X2>0 and Y1>0 and Y2>0 and X2>=X1 and Y2>=Y1:
   xlsRange1=AsAutoObject(objSheet.Cells[X1,Y1]);
   xlsRange2=AsAutoObject(objSheet.Cells[X2,Y2]);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange1, xlsRange2]);
     Try
       if lineЛевая:          УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeLeft,     lineСтиль, lineТолщина); fi;
       if lineВерхняя:        УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeTop,      lineСтиль, lineТолщина); fi;
       if lineПравая:         УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeRight,    lineСтиль, lineТолщина); fi;
       if lineНижняя:         УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlEdgeBottom,   lineСтиль, lineТолщина); fi;
       if lineДиагональВверх: УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalUp,   lineСтиль, lineТолщина); fi;
       if lineДиагональВниз:  УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlDiagonalDown, lineСтиль, lineТолщина); fi;
       if Y2>Y1 and lineВнутриВер: УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlInsideVertical,   lineСтиль, lineТолщина); fi;
       if X2>X1 and lineВнутриГор: УстановитьГраницу(xlsRangeRes, РАБ.EXCEL.xlInsideHorizontal, lineСтиль, lineТолщина); fi;
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsRange1);
     ClearVariable(xlsRange2);
   end;
 fi;
end;

Proc ПодчеркнутыйТекстЯчеек(objSheet:AutoObject; X1:Integer; Y1:Integer; X2:Integer; Y2:Integer; ДвойнаяЛиния:Logical; ЛинияПоВсейЯчейке:Logical; Нужно:Logical);
-- objSheet - ссылка на лист
-- X1, Y1   - координаты ячейки листа objSheet - левый верхний угол диапазона для объединения
-- X2, Y2   - координаты ячейки листа objSheet - правый нижний угол диапазона для объединения
-- Нужно    - применяется или нет подчеркнутый текст
-- ДвойнаяЛиния, ЛинияПоВсейЯчейке - данные параметры определяют стиль подчеркнутого текста
-- Нужно    - если False параметры ДвойнаяЛиния, ЛинияПоВсейЯчейке игнорируются, установленный стиль подчеркивания сбрасывается

var xlsRangeRes, xlsRange1, xlsRange2, xlsFont :AutoObject;
var xls_Стиль :Integer;
 if X1>0 and X2>0 and Y1>0 and Y2>0 and X2>=X1 and Y2>=Y1:
   xlsRange1=AsAutoObject(objSheet.Cells[X1,Y1]);
   xlsRange2=AsAutoObject(objSheet.Cells[X2,Y2]);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange1, xlsRange2]);
     Try
       xlsFont=AsAutoObject(xlsRangeRes.Font);
       Try
         if Нужно:
           if ДвойнаяЛиния:
             if ЛинияПоВсейЯчейке: xls_Стиль=xlUnderlineStyleDouble; else xls_Стиль=xlUnderlineStyleDoubleAccounting; fi;
           else
             if ЛинияПоВсейЯчейке: xls_Стиль=xlUnderlineStyleSingle; else xls_Стиль=xlUnderlineStyleSingleAccounting; fi;
           fi;
         else
           xls_Стиль = РАБ.EXCEL.xlUnderlineStyleNone;
         fi;
         xlsFont.Underline = xls_Стиль;
       Finally
         ClearVariable(xlsFont);
       end;
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsRange1);
     ClearVariable(xlsRange2);
   end;
 fi;
end;

Proc ВыделитьСловоЖирнымВстроке(objSheet:AutoObject; XX:Integer; YY:Integer; start:Integer; len:Integer);
-- * ВЫДЕЛИТЬ ЧАСТЬ СЛОВА или ПРЕДЛОЖЕНИЯ ЖИРНЫМ начиная с позиции start и продолжительностью len *
-- objSheet           - ссылка на лист
-- XX, YY             - координаты ячейки листа objSheet
-- start              - начальная позиции выделения жирным
-- len                - продолжительность выделения жирным
var xlsRng, xlsCrt, xlsFnt :AutoObject;
 xlsRng=AsAutoObject(objSheet.Cells[XX, YY]);
 Try
   xlsCrt=AsAutoObject(xlsRng.Characters(start, len));
   Try
     xlsFnt=AsAutoObject(xlsCrt.Font);
     Try
       xlsFnt.Bold = True;
     Finally
       ClearVariable(xlsFnt);
     end;
   Finally
     ClearVariable(xlsCrt);
   end;
 Finally
   ClearVariable(xlsRng);
 end;
end;

Proc УстановитьРазмерШрифтаЧастиСлова(objSheet:AutoObject; XX:Integer; YY:Integer; start:Integer; len:Integer; РазмерШрифта:Integer);
-- objSheet           - ссылка на лист
-- XX, YY             - координаты ячейки листа objSheet
-- start              - начальная позиции выделения части слова
-- len                - продолжительность выделения части слова
var xlsRng, xlsCrt, xlsFnt :AutoObject;
 xlsRng=AsAutoObject(objSheet.Cells[XX, YY]);
 Try
   xlsCrt=AsAutoObject(xlsRng.Characters(start, len));
   Try
     xlsFnt=AsAutoObject(xlsCrt.Font);
     Try
       xlsFnt.Size = РазмерШрифта;
     Finally
       ClearVariable(xlsFnt);
     end;
   Finally
     ClearVariable(xlsCrt);
   end;
 Finally
   ClearVariable(xlsRng);
 end;
end;

Proc ПовернутьТекст(objSheet:AutoObject; XX:Integer; YY:Integer; наГрадус:Integer; нижеГоризонта:Logical);
-- * ПОВЕРНУТЬ ТЕКСТ НА УКАЗАННЫЙ ГРАДУС ВЫШЕ ИЛИ НИЖЕ ГОРИЗОНТА *
-- objSheet           - ссылка на лист
-- XX, YY             - координаты ячейки листа objSheet
-- наГрадус           - градус поворота текста
-- нижеГоризонта      - наклон снизу вверх или сверху вниз
var xlsRng :AutoObject;
 if наГрадус>0 and наГрадус<180:
   xlsRng=AsAutoObject(objSheet.Cells[XX, YY]);
   Try
     if нижеГоризонта: xlsRng.Orientation = -(наГрадус); else xlsRng.Orientation = наГрадус; fi;
   Finally
     ClearVariable(xlsRng);
   end;
 fi;
end;

Proc АвтоВыравниваниеСтрок(objSheet:AutoObject; XX:Integer; YY:Integer);
-- * АВТОМАТИЧЕСКОЕ ВЫРАВНИВАНИЕ СТРОК В ДИАПАЗОНЕ  *
-- objSheet           - ссылка на лист
-- XX, YY             - строки с XX по YY
var xlsRng :AutoObject;
 if XX>0 and YY>0 and XX<=YY:
   xlsRng=AsAutoObject(objSheet.Rows[Str(XX)+":"+Str(YY)]);
   Try
     xlsRng.AutoFit;
   Finally
     ClearVariable(xlsRng);
   end;
 fi;
end;

Proc ИмпортПроцедурыVBA(objApp:AutoObject; objBook:AutoObject);
-- * Импорт процедуры VBA - для передачи в Excel внешней процедуры *
-- << данная процедура только пример !!! >>
-- objApp  - ссылка на экземпляр EXCEL'а
-- objBook - ссылка на рабочую книгу для вставки внешней процедуры

-- Для работы процедуры необходимо разрешить доступ к проекту VBA.
-- Для этого запустите Excel и последовательно выберите в меню Сервис команды Макрос и Безопасность.
-- В диалоговом окне Безопасность откройте вкладку Надежные источники и установите флажок "Доверять доступ к Visual Basic Project".
--
var xlsVBE, xlsAVBEP, xlsVBC :AutoObject;
var ВременныйФайл :String;
var FlagCreate :Logical;
var FF :Integer;

 -- Application.VBE.ActiveVBProject.VBComponents.Import "C:\Test.bas"

 xlsVBE   = AsAutoObject(objApp.VBE);
 xlsAVBEP = AsAutoObject(xlsVBE.ActiveVBProject);
 xlsVBC   = AsAutoObject(xlsAVBEP.VBComponents);

 ВременныйФайл=PlanVar('CACHE')+"\"+"PalletteColorAdd.bas";
 if ExistFile(ВременныйФайл): DeleteFile(ВременныйФайл); fi;
 Try
   Try
     FlagCreate=False;
     FF=TextFileCreate(ВременныйФайл);
     if not ExistFile(ВременныйФайл): Message("Ошибка создания файла: "+ВременныйФайл, mtError); Exit; fi;
     FlagCreate=True;

     TextFileWriteLn(FF, "Public Sub PalletteColorAdd(refBook As Object)");
     TextFileWriteLn(FF, "");
     TextFileWriteLn(FF, "refBook.ResetColors");
     TextFileWriteLn(FF, "");

     TextFileWriteLn(FF, "refBook.Colors(1)  = RGB(255, 200, 160)");
     TextFileWriteLn(FF, "refBook.Colors(2)  = RGB(255, 220, 180)");
     TextFileWriteLn(FF, "refBook.Colors(3)  = RGB(255, 220, 220)");
     TextFileWriteLn(FF, "refBook.Colors(4)  = RGB(255, 240, 220)");
     TextFileWriteLn(FF, "refBook.Colors(5)  = RGB(255, 240, 200)");

     TextFileWriteLn(FF, "refBook.Colors(6)  = RGB(255, 160, 200)");
     TextFileWriteLn(FF, "refBook.Colors(7)  = RGB(255, 180, 220)");
     TextFileWriteLn(FF, "refBook.Colors(8)  = RGB(255, 220, 220)");
     TextFileWriteLn(FF, "refBook.Colors(9)  = RGB(255, 220, 240)");
     TextFileWriteLn(FF, "refBook.Colors(10) = RGB(255, 200, 240)");

     TextFileWriteLn(FF, "refBook.Colors(11) = RGB(160, 255, 200)");
     TextFileWriteLn(FF, "refBook.Colors(12) = RGB(180, 255, 220)");
     TextFileWriteLn(FF, "refBook.Colors(13) = RGB(220, 255, 220)");
     TextFileWriteLn(FF, "refBook.Colors(14) = RGB(220, 255, 240)");
     TextFileWriteLn(FF, "refBook.Colors(15) = RGB(200, 255, 240)");

     TextFileWriteLn(FF, "refBook.Colors(16) = RGB(200, 255, 160)");
     TextFileWriteLn(FF, "refBook.Colors(17) = RGB(220, 255, 180)");
     TextFileWriteLn(FF, "refBook.Colors(18) = RGB(220, 255, 220)");
     TextFileWriteLn(FF, "refBook.Colors(19) = RGB(240, 255, 220)");
     TextFileWriteLn(FF, "refBook.Colors(20) = RGB(240, 255, 200)");

     TextFileWriteLn(FF, "refBook.Colors(21) = RGB(200, 160, 255)");
     TextFileWriteLn(FF, "refBook.Colors(22) = RGB(220, 180, 255)");
     TextFileWriteLn(FF, "refBook.Colors(23) = RGB(220, 220, 255)");
     TextFileWriteLn(FF, "refBook.Colors(24) = RGB(240, 220, 255)");
     TextFileWriteLn(FF, "refBook.Colors(25) = RGB(240, 200, 255)");

     TextFileWriteLn(FF, "refBook.Colors(26) = RGB(160, 200, 255)");
     TextFileWriteLn(FF, "refBook.Colors(27) = RGB(180, 220, 255)");
     TextFileWriteLn(FF, "refBook.Colors(28) = RGB(220, 220, 255)");
     TextFileWriteLn(FF, "refBook.Colors(29) = RGB(220, 240, 255)");
     TextFileWriteLn(FF, "refBook.Colors(30) = RGB(200, 240, 255)");

     TextFileWriteLn(FF, "refBook.Colors(31) = RGB(255, 200, 200)");
     TextFileWriteLn(FF, "refBook.Colors(32) = RGB(200, 255, 200)");
     TextFileWriteLn(FF, "refBook.Colors(33) = RGB(200, 200, 255)");
     TextFileWriteLn(FF, "refBook.Colors(34) = RGB(220, 220, 220)");
     TextFileWriteLn(FF, "refBook.Colors(35) = RGB(255, 255, 170)");

     TextFileWriteLn(FF, "");
     TextFileWriteLn(FF, "End Sub");

   Except
     if FlagCreate:
       Message("Ошибка записи в файл '"+ВременныйФайл+"'!", mtError);
     else
       Message("Ошибка создания файла '"+ВременныйФайл+"'!", mtError);
     fi;
     Raise;
   end;
 Finally
   TextFileClose(FF);
 end;

 xlsVBC.Import(ВременныйФайл);
 -- Application.Run "Test", oSheet
 objApp.Run("PalletteColorAdd", objBook);

 if ExistFile(ВременныйФайл): DeleteFile(ВременныйФайл); fi;

end;

Func КоличествоЛистовКниги(objBook:AutoObject) :Integer;
-- * УЗНАЕМ КОЛИЧЕСТВО ЛИСТОВ КНИГИ *
-- objBook - ссылка на рабочую книгу
var xlsSheets :AutoObject;
var num :Integer;
 num=0;
 xlsSheets=AsAutoObject(objBook.Sheets);
 Try
   num=asInteger(xlsSheets.Count);
 Finally
   ClearVariable(xlsSheets);
 end;
 ^num;
end;

Func РусскийExcel(objApp:AutoObject) :Logical;
-- * УЗНАЕМ - В СИСТЕМЕ УСТАНОВЛЕН РУССКИЙ EXCEL АЛЬ НЕТ *
-- objApp  - ссылка на экземпляр EXCEL'а
var xlsLS :AutoObject;
 --Application.LanguageSettings.LanguageID(msoLanguageIDUI)
 xlsLS=AsAutoObject(objApp.LanguageSettings);
 Try
   if asInteger(xlsLS.LanguageID[РАБ.EXCEL.msoLanguageIDUI])=1049: ^True; fi;
 Finally
   ClearVariable(xlsLS);
 end;
 ^False;
end;

Func ФорматироватьАмперсанд(srcString:String) :String;
-- * ВСПОМОГАТЕЛЬНАЯ ФУНКЦИЯ ДЛЯ РАСПОЗНОВАНИЯ СИМВОЛА '&' *
-- применяется при выводе в колонтитулы служебной информации
var num, ii :Integer;
var Char, Res :String;
 Res="";
 num=Length(srcString);
 if num>0:
   for ii=1 to num do
     Char=SubStr(srcString, ii, 1);
     if Char="&": Res=Res+"&&"; else Res=Res+Char; fi;
   od;
 fi;
 ^Res;
end;

Proc РазрывСтраницы(objSheet:AutoObject; Row:Integer);
-- * ПРОГРАММНО ВСТАВЛЯЕМ РАЗРЫВ СТРАНИЦЫ *
-- применение: например, для вывода разных таблиц на отдельных страницах
-- objSheet  - ссылка на лист
-- Row       - строка, с которой начинается разрыв страницы
var xlsRange, xlsRangeRes, xlsHPageBreak :AutoObject;
 xlsRange=AsAutoObject(objSheet.Cells[Row, 1]);
 Try
   xlsHPageBreak=AsAutoObject(objSheet.HPageBreaks);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange, xlsRange]);
     Try
     --ActiveSheet.HPageBreaks.Add (ActiveSheet.Range(Cells(7, 1), Cells(7, 1)))
     xlsHPageBreak.Add(xlsRangeRes);
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsHPageBreak);
   end;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc УстановитьКомментДляЯчеки(objSheet:AutoObject; X:Integer; Y:Integer; Value:String);
-- * ПРОГРАММНО ДОБАВЛЯЕМ КОММЕНТАРИЙ К ЯЧЕЙКЕ *
-- objSheet         - ссылка на лист
-- X, Y             - координаты ячейки листа objSheet
-- Value            - текст комментария
var xlsRange, xlsNewCmmt, xlsEditCmmt, xlsShape, xlsTextFrame :AutoObject;
var sw, sh, lArea :Numeric;
 xlsRange=AsAutoObject(objSheet.Cells[X,Y]);
 Try
   xlsNewCmmt=AsAutoObject(xlsRange.AddComment);
   Try
     xlsNewCmmt.Visible = False;
     xlsNewCmmt.Text(Value);
     xlsEditCmmt=AsAutoObject(xlsRange.Comment);
     Try
       xlsShape=AsAutoObject(xlsEditCmmt.Shape);
       Try
         xlsTextFrame=AsAutoObject(xlsShape.TextFrame);
         Try
           xlsTextFrame.AutoSize = True;
           sw=asReal(xlsShape.Width);
           sh=asReal(xlsShape.Height);
           if sw>300:
             lArea = sw * sh;
             xlsShape.Width  = 200;
             xlsShape.Height = (lArea / 200) * 1.1;
           fi;
         Finally
           ClearVariable(xlsTextFrame);
         end;
       Finally
         ClearVariable(xlsShape);
       end;
     Finally
       ClearVariable(xlsEditCmmt);
     end;
   Finally
     ClearVariable(xlsNewCmmt);
   end;
 Finally
   ClearVariable(xlsRange);
 end;
end;

Proc НадстрочноеНачертаниеДиапазона(objSheet:AutoObject; X1:Integer; Y1:Integer; X2:Integer; Y2:Integer; Use:Logical);
-- * ФОРМАТИРОВАТЬ ЯЧЕЙКУ (УСТАНОВИТЬ СТИЛЬ) - НАДСТРОЧНОЕ НАЧЕРТАНИЕ ШРИФТА *
-- objSheet      - ссылка на лист
-- X1, Y1        - координаты ячейки листа objSheet - левый верхний угол диапазона для объединения
-- X2, Y2        - координаты ячейки листа objSheet - правый нижний угол диапазона для объединения
-- Use           - применить стиль или отменить
var xlsRange1, xlsRange2, xlsRangeRes, xlsFont :AutoObject;
 if X1>0 and X2>0 and Y1>0 and Y2>0 and X2>=X1 and Y2>=Y1:
   xlsRange1=AsAutoObject(objSheet.Cells[X1,Y1]);
   xlsRange2=AsAutoObject(objSheet.Cells[X2,Y2]);
   Try
     xlsRangeRes=AsAutoObject(objSheet.Range[xlsRange1, xlsRange2]);
     Try
       xlsFont=AsAutoObject(xlsRangeRes.Font);
       Try
         xlsFont.Superscript = Use;
       Finally
         ClearVariable(xlsFont);
       end;
     Finally
       ClearVariable(xlsRangeRes);
     end;
   Finally
     ClearVariable(xlsRange1);
     ClearVariable(xlsRange2);
   end;
 fi;
end;

Func ТрансляцияДиапазонаКолонок(c1:Integer; c2:Integer) :String;
var Res, v1, v2: String;
 Res=""; v1=""; v2="";
 if c1>0 and c1<=c2 and c2<27:
   ClearVariable(РАБ.EXCEL.Buf);
   РАБ.EXCEL.Buf[01]="$A";
   РАБ.EXCEL.Buf[02]="$B";
   РАБ.EXCEL.Buf[03]="$C";
   РАБ.EXCEL.Buf[04]="$D";
   РАБ.EXCEL.Buf[05]="$E";
   РАБ.EXCEL.Buf[06]="$F";
   РАБ.EXCEL.Buf[07]="$G";
   РАБ.EXCEL.Buf[08]="$H";
   РАБ.EXCEL.Buf[09]="$I";
   РАБ.EXCEL.Buf[10]="$J";
   РАБ.EXCEL.Buf[11]="$K";
   РАБ.EXCEL.Buf[12]="$L";
   РАБ.EXCEL.Buf[13]="$M";
   РАБ.EXCEL.Buf[14]="$N";
   РАБ.EXCEL.Buf[15]="$O";
   РАБ.EXCEL.Buf[16]="$P";
   РАБ.EXCEL.Buf[17]="$Q";
   РАБ.EXCEL.Buf[18]="$R";
   РАБ.EXCEL.Buf[19]="$S";
   РАБ.EXCEL.Buf[20]="$T";
   РАБ.EXCEL.Buf[21]="$U";
   РАБ.EXCEL.Buf[22]="$V";
   РАБ.EXCEL.Buf[23]="$W";
   РАБ.EXCEL.Buf[24]="$X";
   РАБ.EXCEL.Buf[25]="$Y";
   РАБ.EXCEL.Buf[26]="$Z";
   v1=РАБ.EXCEL.Buf[c1];
   v2=РАБ.EXCEL.Buf[c2];
   if v1<>"" and v2<>"": Res=v1+":"+v2; fi;
   ClearVariable(РАБ.EXCEL.Buf);
 fi;
 ^Res;
end;

Proc PrintSetup_ЧБ_Поля10(objApp:AutoObject; objSheet:AutoObject; ОриентПортрет:Logical; r1:Integer; r2:Integer; c1:Integer; c2:Integer; РовнятьГор:Logical; РовнятьВер:Logical; ВнизВправо:Logical; Масштаб:Integer);
-- * ПАРАМЕТРЫ СТРАНИЦЫ - НАСТРОЙКА *
-- objApp        - ссылка на экземпляр Excel
-- objSheet      - ссылка на рабочий лист
-- ОриентПортрет - портретная или альбомная ориентация листа
-- r1 r2         - диапазон 'сквозных' строк
-- c1 c2         - диапазон 'сквозных' колонок
-- РовнятьГор    - центрировать печать горизонтально
-- РовнятьВер    - центрировать печать вертикально
-- ВнизВправо    - вниз, затем вправо или вправо, затем вниз
-- Масштаб       - цифра (%) от 20 до 400, цифра 100 - натуральная величина
var xlsRng :AutoObject;
var Value :String;
var valNum :Numeric;
 xlsRng=AsAutoObject(objSheet.PageSetup);
 Try
   xlsRng.Orientation = if(ОриентПортрет, РАБ.EXCEL.xlPortrait, РАБ.EXCEL.xlLandscape);
   if r1>0 and r1<=r2: xlsRng.PrintTitleRows    = "$"+Str(r1)+":$"+Str(r2);  fi;
   if c1>0 and c1<=c2: Value=ТрансляцияДиапазонаКолонок(c1, c2); if Value<>"": xlsRng.PrintTitleColumns = Value; fi; fi;
   xlsRng.CenterHorizontally = РовнятьГор;
   xlsRng.CenterVertically   = РовнятьВер;
   xlsRng.BlackAndWhite = True;
   if ВнизВправо: xlsRng.Order = РАБ.EXCEL.xlDownThenOver; else xlsRng.Order = РАБ.EXCEL.xlOverThenDown; fi;
   if Масштаб>19 and Масштаб<401: xlsRng.Zoom = Масштаб; else xlsRng.Zoom = 100; fi;
   --
   valNum=asReal(objApp.InchesToPoints[0.393700787401575]);
   xlsRng.LeftMargin   = valNum;
   xlsRng.RightMargin  = valNum;
   xlsRng.TopMargin    = valNum;
   xlsRng.BottomMargin = valNum;
   valNum=asReal(objApp.InchesToPoints[0.196850393700787]);
   xlsRng.HeaderMargin = valNum;
   xlsRng.FooterMargin = valNum;
 Finally
   ClearVariable(xlsRng);
 end;
end;

Proc PrintSetup_Колонтитулы(objSheet:AutoObject; flgRusExcel:Logical; Value:String);
-- * КОЛОНТИТУЛЫ - НАСТРОЙКА *
-- !!! ДАННАЯ ПРОЦЕДУРА ДАНА ДЛЯ ПРИМЕРА !!!
-- objSheet     - ссылка на рабочий лист
-- flgRusExcel  - применяется русифицированных EXCEL
-- Value        - строка для записи в колонтитул
var xlsRng :AutoObject;
 xlsRng=AsAutoObject(objSheet.PageSetup);
 Try
   if flgRusExcel:
     xlsRng.LeftHeader  = '&"Arial,обычный"&7'+Value;
     xlsRng.RightFooter = '&"Arial,полужирный"&8Страница &С из &К';
   else
     xlsRng.LeftHeader  = '&"Arial,normal"&7'+Value;
     xlsRng.RightFooter = '&"Arial,bold"&8Страница &P из &N';
   fi;
   --xlsRng.LeftHeader     - верхний левый
   --xlsRng.CenterHeader   - верхний центральный
   --xlsRng.RightHeader    - верхний правый
   --xlsRng.LeftFooter     - нижний левый
   --xlsRng.CenterFooter   - нижний центральный
   --xlsRng.RightFooter    - нижний правый
 Finally
   ClearVariable(xlsRng);
 end;
end;

Func Бланк_HTML_to_Excel(path_Бланк_HTML:String; MessageOn:Logical) :String;
var xlsApp, xlsBooks, xlsBook :AutoObject;
var path_XLSFile, ExcelVersion :String;
var saveVersion :Integer;
var NoError :Logical;
 NoError=False;
 path_Бланк_HTML=РАБ.БЮДЖЕТ2005.Контроль2Слэш(path_Бланк_HTML);
 if ExistFile(path_Бланк_HTML):
   if MessageOn: ShowProgress(0, "Конвертация файла..."); fi;
   Try
     path_XLSFile=ExtractWords(1, WordsCount(path_Бланк_HTML, ".")-1, path_Бланк_HTML, ".")+".xls";
     if ExistFile(path_XLSFile):
       if MessageOn: if EnqOkCancel("Файл "+path_XLSFile+" уже существет.^MПерезаписать?", mtWarning)=cmCancel: ^""; fi; fi;
       Try DeleteFile(path_XLSFile); Except end;
     fi;
     xlsApp=CreateAutoObject('Excel.Application');
     Try
       Try
         xlsBooks=AsAutoObject(xlsApp.Workbooks); -- получить объект Workbooks
         Try
           xlsBook=AsAutoObject(xlsBooks.Open(path_Бланк_HTML)); -- открыть книгу
           Try
             Try
               ExcelVersion=asString(xlsApp.Version);
               if Int(ExcelVersion)>=12 or ExcelVersion="12.0": saveVersion=РАБ.EXCEL.xlExcel8; else saveVersion=РАБ.EXCEL.xlExcel9795; fi;
               xlsBook.SaveAs(path_XLSFile, saveVersion);
               NoError=True;
             Except
               NoError=False;
               xlsBook.Close(False); -- закрыть книгу без сохранения
               ClearVariable(xlsBook); -- освободить объект книги
             end;
           Finally
             xlsBook.Close(False); -- закрыть книгу без сохранения
             ClearVariable(xlsBook); -- освободить объект книги
           end;
         Finally
           ClearVariable(xlsBooks); -- освободить объект книг
         end;
       Finally
         ClearVariable(xlsApp); -- освободить объект Excel
       end;
     Except
       ClearVariable(xlsBook);
       ClearVariable(xlsBooks);
       ClearVariable(xlsApp);
     end;
   Finally
     if MessageOn: CloseProgress; fi;
   end;
 else
   if MessageOn: Message("Файл^M'"+path_Бланк_HTML+"'^Mне найден.", mtError); fi;
   ^"";
 fi;
 ^if(NoError and ExistFile(path_XLSFile), path_XLSFile, "");
end; 

КОНЕЦ -- конец бланка