***Проверка наличия файла и его удаления при наличии***
IF FILE("D:\Are\OUT\Справочники.xlsb")
	DELETE FILE "D:\Are\OUT\Справочники.xlsb"
ENDIF
***Попытка поймать ошибку***
ON ERROR DO errhand	  && errhand is the error handler procedure
fil_excel = "D:\Are\Shab\Shab.xlsb" && выбор файла шаблона из текущей директории и директории SHABLON
filnam_r = "Shab.xlsb" && Имя файла эксель
nam_fil = "D:\Are\OUT\Справочники.xlsb" &&Указание директории и имений файла в который выгружаем
fil_new = (nam_fil)
ERASE (fil_new)	&&Удаляем файл для перезаписи
ole2 = GETOBJECT(fil_excel)
ole2.application.windows(filnam_r).activate
ole1 = ole2.application
	WITH ole1
		.activeworkbook.saveas(fil_new)
DO sprav
		.range("A1").select				&& Перемещение курсора в ячейку
    ENDWITH
WAIT CLEAR
ole1.visible = .T.	&& Отображение файла на экране
RELEASE ole1	&& Закрытие процесса Excel
ON ERROR  && Restore system error handler


PROCEDURE sprav
.sheets("sprav ").select	&& выбор листа
	SELECT sprav	&& выбор исходного файла
	COUNT TO kolz		&&&Общее кол-во записей
	nomst = 2	&& определение строки с которой пишем для всех справочников
	SCAN 
		WAIT WINDOW 'Формирование списка sprav запись № '+ALLTRIM(STR(nomst-2))+' из ' +ALLTRIM(STR(kolz)) NOWAIT 
		ole1.parent.cells(nomst, 1).value = field1
*!*			.sheets("sprav").Hyperlinks.Add(.sheets("sprav").cells(nomst,1),"","sprav2!A1","Ссылка на что-то там")	&&Создаем гипперсылку на sprav
		ole1.parent.cells(nomst, 2).value = field2
		ole1.parent.cells(nomst, 3).value = ALLTRIM(field3)
		ole1.parent.cells(nomst, 4).value = field4
		ole1.parent.cells(nomst, 5).value = field5
		ole1.parent.cells(nomst, 6).value = field6
		ole1.parent.cells(nomst, 7).value = field7
		nomst = nomst+1
	ENDSCAN
				
	**** Разлиновка ячеейк****
	.range(.cells(1, 1), .cells(nomst-1, 7)).select 
		WITH .selection
			.borders.linestyle = 1
			.borders.weight = 2
		ENDWITH
	.range("A1").select	&& Перемещение курсора в ячейку
ENDPROC

PROCEDURE errhand
*!*		SUSPEND	&&Пауза для отладки
	= AERROR(aErrorArray)  && Data from most recent error
*!*		CLEAR
*!*		? 'The error provided the following information'  && Display message
		? 'И где что не то'
		? 'На листе: '+ALLTRIM(ole1.ActiveSheet.name)
		? 'Номер строки: ' +ALLTRIM(STR(nomst))
*!*			? 'На листе' + ActiveSheet.name
	FOR n = 1 TO 7  && Display all elements of the array
		? aErrorArray(n)
	ENDFOR
	IF aErrorArray(1,1)=1426	&&Если в массиве первая запись с кодом ошибки 1426
		RETRY	&&Пытаемся по новой записать значение
	ENDIF 
ENDPROC

***В эксель***
PROCEDURE v_excel
***Вставляем в excel***
IF vartype(ole1)='L'
	ole1 = CreateObject("Excel.Application")
	ole1.WorkBooks.add
	ole2=ole1.Application
ENDIF
WITH ole2
IF tek_chto>3	&&вствляем новый лист в конец, если номер чего-то по порядку более 3
		ole2.Sheets.Add(null,ole2.Sheets(tek_chto-1),(tek_chto+1)-tek_chto)
	ENDIF
	.sheets(tek_chto).name="что-то "+ALLTRIM(STR(o_code))
	.sheets(tek_chto).select	&&Выбираем лист соответствующий текущему номеру по порядку чего-то
***Наименование шапки делаем****
	***На 2016 год***
	ole2.parent.cells(1, 1).value = 'Данные 2016 года'
	ole2.parent.cells(2, 1).value = 'Что-то 2016'
	ole2.parent.cells(2, 2).value = 'Наименование чего-то'
	ole2.parent.cells(2, 3).value = 'Код чего-то2'
	ole2.parent.cells(2, 4).value = 'Наименование чего-то2'
	ole2.parent.cells(2, 5).value = 'чего-то3'
	ole2.parent.cells(2, 6).value = 'Наименование чего-то3'
	ole2.parent.cells(2, 7).value = 'Примечания по чего-то3'
	ole2.parent.cells(2, 8).value = 'Ограничение по возрасту'
	ole2.parent.cells(2, 9).value = 'Решение о включении в куда-то 2016'

	***Приводим шапку в порядок 2016***
	.range(.cells(1, 1), .cells(1, 9)).select
		WITH .selection
			.Font.Size = 14		&&Размер шрифта
			.Font.Bold = .T. 	&&жирность
			.MergeCells = .T. && обьединение ячееке
			.HorizontalAlignment = 3	&&горизонтали по центру
			.VerticalAlignment = 2	&&вертикали по центру
		ENDWITH
	***Ширина столбцов***
	***На 2016 год***
	ole2.Columns(1).ColumnWidth=5
	ole2.Columns(2).ColumnWidth=20
	ole2.Columns(3).ColumnWidth=8.86
	ole2.Columns(4).ColumnWidth=14.29
	ole2.Columns(5).ColumnWidth=16
	ole2.Columns(6).ColumnWidth=20
	ole2.Columns(7).ColumnWidth=11.86
	ole2.Columns(8).ColumnWidth=12.43
	ole2.Columns(9).ColumnWidth=12.43
	Вставляем данные
	.range("A3").select	&& Перемещение курсора в ячейку
	.ActiveWindow.FreezePanes= .T.	&&Закрепляем шапку для скроллинга
ENDWITH
***Закрывает только тогда, когда номер чего-то по порядку равняется общему кол-ву чего-то*****
IF kol_chto =tek_chto
	RELEASE ole1	&& Закрытие процесса Excel
	ole2.activeworkbook.saveas(fil_new)		&&Сохраняем
	ole2.Application.Quit	&&Типо выход?
	RELEASE ole2	&& Закрытие процесса Excel
ENDIF

CREATE CURSOR test_v_excel (id N(4),name C(30),date_v D)
INSERT INTO test_v_excel (id,name,date_v) VALUES (1,'Строка 1',CTOD('17.10.2016'))
INSERT INTO test_v_excel (id,name,date_v) VALUES (2,'Строка 2',CTOD('15.10.2016'))
INSERT INTO test_v_excel (id,name,date_v) VALUES (3,'Строка 5',CTOD('18.10.2016'))
INSERT INTO test_v_excel (id,name,date_v) VALUES (4,'Строка 6',CTOD('20.10.2016'))

***Создаем экземпляр Excel***
ole1 = CreateObject("Excel.Application")
ole1.WorkBooks.add
ole2=ole1.Application

WITH ole2
***Наименование шапки делаем****
	ole2.parent.cells(1, 1).value = 'Тестовый пример'
	ole2.parent.cells(2, 1).value = 'ID'
	ole2.parent.cells(2, 2).value = 'Номер строки'
	ole2.parent.cells(2, 3).value = 'Дата'
	***Приводим шапку в порядок***
	.range(.cells(1, 1), .cells(1, 3)).select
		WITH .selection
			.Font.Size = 14		&&Размер шрифта
			.Font.Bold = .T. 	&&жирность
			.MergeCells = .T. && обьединение ячееке
			.HorizontalAlignment = 3	&&горизонтали по центру
			.VerticalAlignment = 2	&&вертикали по центру
		ENDWITH
	***Ширина столбцов***
	ole2.Columns(2).ColumnWidth=20
	ole2.Columns(3).ColumnWidth=9.43

	***Тут выгружаем данные***
	nomst = 3	&& определение строки с которой пишем
	SELECT test_v_excel
	SCAN
		ole2.parent.cells(nomst, 1).value = id
		ole2.parent.cells(nomst, 2).value = ALLTRIM(name)
		ole2.parent.cells(nomst, 3).value = date_v
		nomst=nomst+1
	ENDSCAN

	*** Разлиновка ячеек***
	.range(.cells(1, 1), .cells(nomst-1, 3)).select 
		WITH .selection
			.borders.linestyle = 1
			.borders.weight = 2
		ENDWITH
	ole2.visible = .t.    &&Выводим окно Excel на показ
ENDWITH 
RELEASE ole1	&& Закрытие процесса Excel
RELEASE ole2	&& Закрытие процесса Excel