SELECT cr1  
  COPY TO C:\TMP\cr1 TYPE XL5

* Перевод в Excel из Grid делаю с помощью GRIDTOEXCEL,из курсора с помощью CURSORTOEXCEL
* тексты GRIDTOEXCEL, CURSORTOEXCEL приведены ниже

* пример перевода из курсора в Excel с последующей выдачей промежуточных итогов и оформления шапки
SELE 0
CREATE CURSOR SOCW (KP N(10),TN C(5),FIO C(40),SUMZ N(16,2),SUMP N(20,2),SUMR N(20,2),S35 N(20,2),S1 N(20,2),PRW L(1))
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (5,'4729 ','Мартинкевич Ярослав Леонардович         ',136.33,375.00,238.67,81.15,2.39,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (5,'4730 ','Мартинкевич Андрей Леонардович          ',118.37,375.00,256.63,87.25,2.57,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (8,'4778 ','Бурдиенко Олег Васильевич               ',300.60,357.86,57.26,19.47,0.57,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (10,'4794 ','Молявко Анна Ежиевна                    ',-3.04,0.00,3.04,1.03,0.03,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (18,'4158 ','Василевская Ванда Альбиновна            ',84.60,100.71,16.11,5.48,0.16,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (18,'4820 ','Перко Наталья Ивановна                  ',281.77,375.00,93.23,31.70,0.93,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (19,'4441 ','Якубчик Тереза Станиславовна            ',273.99,367.07,93.08,31.65,0.93,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (19,'4751 ','Нехвядович Анастасия Валентиновна       ',261.74,372.86,111.12,37.78,1.11,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (21,'4863 ','Савуль Александр Станиславович          ',25.95,51.43,25.48,8.66,0.25,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'4100 ','Максимова Людмила Викторовна            ',66.82,68.57,1.75,0.60,0.02,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'4331 ','Сягло Оксана Ивановна                   ',366.52,375.00,8.48,2.88,0.08,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'4366 ','Мурачинская Татьяна Александровна       ',161.07,171.43,10.36,3.52,0.10,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'4487 ','Анацко Иван Викторович                  ',244.48,257.14,12.66,4.30,0.13,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'4584 ','Барановский Эдуард Цезарьевич           ',198.88,272.14,73.26,24.91,0.73,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'4615 ','Яговдик Екатерина Александровна         ',245.97,375.00,129.03,43.87,1.29,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'4767 ','Радевич Оксана Владимировна             ',324.63,375.00,50.37,17.13,0.50,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (24,'736  ','Дуки Викентий Чеславович                ',352.35,375.00,22.65,7.70,0.23,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (18,'3602 ','Жук Татьяна Александровна               ',361.40,411.99,50.59,8.84,0.26,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (18,'3710 ','Чижик Анна Яновна                       ',242.88,276.88,34.00,11.56,0.34,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (18,'4623 ','Керней Марина Александровна             ',209.84,256.94,47.10,15.98,0.47,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (18,'4643 ','Василевская Ванда Альбиновна            ',238.78,292.38,53.60,18.36,0.54,.T.)
INSERT INTO SOCW (KP,TN,FIO,SUMZ,SUMP,SUMR,S35,S1,PRW) VALUES (18,'4821 ','Якубчик Ольга Игоревна                  ',310.08,394.27,84.19,26.52,0.78,.T.)

*!*			oGrid=This.Parent.Grid1
*!*			cFileName=''
*!*			oExcel=GRIDTOEXCEL(oGrid,cFileName)
*!*			With oGrid
*!*				cGridFile=.RecordSource
*!*				Select (cGridFile)
*!*				Count To nReccount
*!*				KPL=FCOUNT()
*!*				If nReccount=0
*!*					Messagebox('Нет данных!',48,'Экспорт в Excel')
*!*					Return .F.
*!*				Endif
*!*			endwith

			Select SOCW
			Count To nReccount
			KPL=FCOUNT()
			If nReccount=0
				Messagebox('Нет данных!',48,'Экспорт в Excel')
				Return .F.
			Endif

SAPKA=[Подразд.*Таб.№*Ф И О*З/п*Прожит.мин.*Отклон.от минимума*34%соц.страх*1%соц.страх*Доплатить*]

oExcel=CURSORTOEXCEL('SOCW')

		with oExcel
			cRangeObj = .ActiveSheet.Range(.Cells(1,1),.Cells(nReccount+1,KPL))
			dimension atemp[5]
			atemp(1)=4
			atemp(2)=5
			atemp(3)=6
			atemp(4)=7
			atemp(5)=8
			xlsum=-4157
			xlCellTypeFormulas=-4123
			cRangeObj.Subtotal(1,xlSum,@atemp,.t.,.f.,.t.)
			.ActiveSheet.Range(.ActiveSheet.Columns(1),.ActiveSheet.Columns(kpl)).AutoFit
			.Selection.SpecialCells(xlCellTypeFormulas, 23).Select
			.Selection.Font.Bold = .T.
	* ЗАПОЛНИМ ШАПКУ
			nGR=GetWordCount(SAPKA,'*')
			FOR I=1 TO nGR
				.ActiveSheet.Cells(1,I).Value = GETWORDNUM(SAPKA,I,'*')
			ENDFOR
		endwith


****************************************************************************************************


PROCEDURE CURSORTOEXCEL
#define cNotReadableSymbols '{}!@^+|`~;<>?$%*&#()[]\/.,:-="'+[']+Chr(32)

Lparameters cCurName
Local cMaska,cGridFile,nReccount,i2,cIndex,nCol,cCaption, ;
	  arrCaptions[1],arrSelectItems[1],arrFields[1,2], ;
      cItem,cFile,cName,cField,cSelectRow,cFilter,cKey,cNewKey,cOrder,lDescending,cCursor, ;
      oErr,lRet,oExcel,nLine,nIndex, ;
      cRangeObj,cABC,cBukva,nLen, ;
      loColumn, loHeader, lnArrRow, lnTag,nColumn

cMaska=Replicate('_',Len(cNotReadableSymbols))
SELECT (cCurName)
nColumn=FCOUNT()
nReccount=RECCOUNT()

*!*	If Empty(cFileName)
*!*		cFileName=addbs(sys(2023)) + ; 
*!*				  Juststem(cCurName)+'.xls'
*!*	ENDIF
Try
*	Copy To (cFileName) Type Xl5
  			oEXCEL=CREATEOBJECT("EXCEL.APPLICATION")  
  			oExcel.Workbooks.Add  
  			oSheet1 = oExcel.WorkSheets("Лист1")  
  			SELECT (cCurName)
  			Count To nReccount  
  			GO top  
  			_vfp.DataToClip(,,3)  
  			With oSheet1  
  				.PasteSpecial("Текст",.F.,.F.)  
  			EndWith  

Catch To oErr
Endtry

*oEXCEL=CREATEOBJECT("EXCEL.APPLICATION")
with oExcel
*!*		.Workbooks.Add(cFileName)
*!*		erase (cFileName)
	.ActiveSheet.Range(.ActiveSheet.Columns(1),.ActiveSheet.Columns(nColumn)).AutoFit
	cRangeObj = .ActiveSheet.Range(.Cells(1,1),.Cells(1,nColumn))
	with cRangeObj
		.Font.Color = Rgb(0,0,128)
		.Font.Name = 'Times'
		.Font.Size = 9
		.Font.FontStyle = 'Bold'
		.Interior.ColorIndex=8
		.Interior.Pattern=1
		.HorizontalAlignment=2
	endwith
	nIndex=nColumn
	cABC="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	nLen=Len(cABC)
	If nIndex<=nLen
		cBukva=Substr(cABC,nIndex,1)
	Else
		If nIndex%nLen=0
			cBukva=Substr(cABC,Int(nIndex/nLen)-1,1)+Substr(cABC,nLen,1)
		Else
			cBukva=Substr(cABC,Int(nIndex/nLen),1)+Substr(cABC,Int(nIndex%nLen),1)
		Endif
	Endif

	.ActiveSheet.Range('A1:'+cBukva+'1').Select()
	Try
		With .Selection
			.BorderS(5).LineStyle=-4142
			.BorderS(6).LineStyle=-4142
			With .BorderS(7)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(8)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(9)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(10)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(11)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(12)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
		Endwith
	Catch When .T.
	Endtry

	.ActiveSheet.Range('A2:'+cBukva+Transform(nReccount+1)).Select()
	Try
		With .Selection
			.BorderS(5).LineStyle=-4142
			.BorderS(6).LineStyle=-4142
			With .BorderS(7)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(8)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(9)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(10)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(11)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(12)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
		Endwith
	Catch When .T.
	Endtry
	.ActiveSheet.Range(.Cells(1,1),.Cells(1,1)).Select()
	.Visible = .T.
ENDWITH
RETURN oEXCEL



*******************************************************************************


PROCEDURE GRIDTOEXCEL

#define cNotReadableSymbols '{}!@^+|`~;<>?$%*&#()[]\/.,:-="'+[']+Chr(32)

Lparameters oGrid,cFileName
Local cMaska,cGridFile,nReccount,i2,cIndex,nCol,cCaption, ;
	  arrCaptions[1],arrSelectItems[1],arrFields[1,2], ;
      cItem,cFile,cName,cField,cSelectRow,cFilter,cKey,cNewKey,cOrder,lDescending,cCursor, ;
      oErr,lRet,oExcel,nLine,nIndex, ;
      cRangeObj,cABC,cBukva,nLen, ;
      loColumn, loHeader, lnArrRow, lnTag

cMaska=Replicate('_',Len(cNotReadableSymbols))

With oGrid
	cGridFile=.RecordSource
	Select (cGridFile)
	Count To nReccount
	If nReccount=0
		Wait Clear
		Messagebox('Нет данных!',48,'Экспорт в Excel')
		Return .F.
	Endif

	For Each loColumn In .Columns
		If loColumn.Visible
			nCol= loColumn.ColumnOrder
			For Each loControl In loColumn.Controls
				If Lower(loControl.BaseClass)="header"
					loHeader = loControl
					Exit
				Endif
			Endfor
			cCaption=loHeader.Caption
			If Empty(cCaption)
				cCaption='Колон_'+Transform(nCol)
			Else
				cCaption=Strtran(cCaption,'№','_номер_')
				cCaption=Strtran(cCaption,'$','_валют_')
				cCaption=Chrtran(cCaption,cNotReadableSymbols,cMaska)
				Do While At('__',cCaption)>0
					cCaption=Strtran(cCaption,'__','_')
				Enddo

				If Right(cCaption,1)=='_' And Len(cCaption)>1
					cCaption=Left(cCaption,Len(cCaption)-1)
				Endif
				If Left(cCaption,1)=='_' And Len(cCaption)>1
					cCaption=Substr(cCaption,2)
				Endif

				cCaption = iif( Isdigit(cCaption), '_'+cCaption, cCaption)

				Do While Ascan(arrCaptions,cCaption)>0
					cCaption=cCaption+'_'
				Enddo
				If Alen(arrCaptions,1)<nCol
					Dimension arrCaptions[nCol]
				Endif
				arrCaptions[nCol]=cCaption

				If !Empty(loColumn.ControlSource)

					If Alen(arrSelectItems,1)<nCol
						Dimension arrSelectItems[nCol]
					Endif

					arrSelectItems[nCol] = iif(type(loColumn.ControlSource)="M", ;
											   "cast("+loColumn.ControlSource+" as c(254))", ;
											   loColumn.ControlSource) + ' AS ' + cCaption

					If Alen(arrFields,1)<nCol
						Dimension arrFields[nCol,2]
					Endif
					cItem=Upper(loColumn.ControlSource)
					If At('.',cItem)=0
						arrFields[nCol,1]=cItem
						arrFields[nCol,2]=Upper(cGridFile)
					Else
						If Upper(cGridFile)$cItem
							arrFields[nCol,1]=Substr(cItem,At('.',cItem)+1)
							arrFields[nCol,2]=Upper(cGridFile)
						Else
							cFile=Substr(cItem,1,At('.',cItem)-1)
							cName=''
							For i2=Len(cFile) To 1 Step -1
								If Substr(cFile,i2,1)$cNotReadableSymbols
									Exit
								Else
									cName=Substr(cFile,i2,1)+cName
								Endif
							Endfor
							arrFields[nCol,2]=cName

							cField=Substr(cItem,At('.',cItem)+1)
							cName=''
							For i2=1 To Len(cField)
								If Substr(cField,i2,1)$cNotReadableSymbols
									Exit
								Else
									cName=cName+Substr(cField,i2,1)
								Endif
							Endfor
							arrFields[nCol,1]=cName
						Endif Upper(cGridFile)$cItem
					Endif At('.',cItem)=0
				Endif  && !empty(loColumn.CONTROLSOURCE)
			Endif
		Endif
	Endfor

	cSelectRow=''
	For lnArrRow = 1 To Alen(arrSelectItems,1)
		If !Empty(arrSelectItems[lnArrRow])
			cSelectRow = cSelectRow + Iif( !Empty(cSelectRow), ",", "") + arrSelectItems[lnArrRow]
		Endif
	Endfor

Endwith
*****************************************************
If Empty(cFileName)
	cFileName=addbs(sys(2023)) + ; 
			  Juststem(cGridFile)+'.xlsx'
Endif

cFilter = Filter(cGridFile)
cFilter = iif( Empty(cFilter), '.T.', cFilter)

Select (cGridFile)
cOrder=Order()
If !Empty(cOrder)
	lDescending=Descending()
	For lnTag = 1 To Tagcount()
		If !Empty(Tag(lnTag))
			If Tag(lnTag)==cOrder
				cKey=Key(lnTag)
				Exit
			Endif
		Else
			Exit
		Endif
	Endfor

	cNewKey=Upper(cKey)
	For lnArrRow=1 To Alen(arrFields,1)
		If Type('arrFields[lnArrRow,2]')='C' And arrFields[lnArrRow,2]==Upper(cGridFile)
			cNewKey=Strtran(cNewKey,Upper(arrFields[lnArrRow,1]),Substr(arrSelectItems[lnArrRow],At('AS ',arrSelectItems[lnArrRow])+3))
		Endif
	Endfor
Endif

cCursor=Sys(2015)
oErr=.Null.
Try
	Select &cSelectRow ;
		FROM (cGridFile) ;
		WHERE &cFilter ;
		INTO Cursor (cCursor) Readwrite
Catch To oErr
Endtry

If Vartype(oErr)=='O' And !Isnull(oErr)
	Messagebox('Ошибка при выполнении запроса: '+oErr.Message,48,'Экспорт в Excel')
	Use In Select(cCursor)
	Return lRet
Endif

If _Tally=0
	Messagebox("Нет информации для экспорта в Microsoft Excel",48,'Экспорт в Excel')
	Use In Select(cCursor)
	Return lRet
Endif

If !Empty(cOrder)
	oErr=.Null.
	Try
		Index On &cNewKey Tag curOrder
	Catch To oErr
	Endtry
	If !(Vartype(oErr)='O' And !Isnull(oErr))
		If lDescending
			Set Order To Tag curOrder Descending
		Else
			Set Order To Tag curOrder
		Endif
	Endif
Endif

Dimension arrFields[1]
arrFields=.F.

Select (cCursor)
Afield(arrFields)

oErr=.Null.

***************************************************

Try
*!*		Copy To (cFileName) Type Xl5
  			oEXCEL=CREATEOBJECT("EXCEL.APPLICATION")  
  			oExcel.Workbooks.Add  
  			oSheet1 = oExcel.WorkSheets("Лист1")  
  			SELECT (cCursor)
  			Count To nReccount  
  			GO top  
  			_vfp.DataToClip(,,3)  
  			With oSheet1  
  				.PasteSpecial("Текст",.F.,.F.)  
  			EndWith  
Catch To oErr
Endtry

***********************************************


Use In Select(cCursor)
If !Isnull(oErr)
	Messagebox('Ошибка экспорта в Excel'+Chr(13)+oErr.Message,48,'Экспорт в Excel')
	Return lRet
Endif

oErr=.Null.
*!*	Try
*!*		oExcel=Createobject("Excel.Application")
*!*	Catch To oErr
*!*	Endtry
*!*	If !Isnull(oErr)
*!*		Messagebox('Ошибка запуска Excel'+Chr(13)+oErr.Message,48,'Экспорт в Excel')
*!*		Return lRet
*!*	Endif

with oExcel
*!*		.Workbooks.Add(cFileName)
*!*		erase (cFileName)
	nLine=1
	For i=1 To Alen(arrFields,1)
		.ActiveSheet.Cells(nLine,i).Value=arrFields[i,1]
	Endfor
	cRangeObj = .ActiveSheet.Range(.Cells(nLine,1),.Cells(nLine,Alen(arrFields,1)))
	with cRangeObj
		.Font.Color = Rgb(0,0,128)
		.Font.Name = 'Times'
		.Font.Size = 9
		.Font.FontStyle = 'Bold'
		.Interior.ColorIndex=8
		.Interior.Pattern=1
		.HorizontalAlignment=2
	endwith
	.ActiveSheet.Range(.ActiveSheet.Columns(1),.ActiveSheet.Columns(Alen(arrFields,1))).AutoFit

	nIndex=Alen(arrFields,1)
	cABC="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	nLen=Len(cABC)
	If nIndex<=nLen
		cBukva=Substr(cABC,nIndex,1)
	Else
		If nIndex%nLen=0
			cBukva=Substr(cABC,Int(nIndex/nLen)-1,1)+Substr(cABC,nLen,1)
		Else
			cBukva=Substr(cABC,Int(nIndex/nLen),1)+Substr(cABC,Int(nIndex%nLen),1)
		Endif
	Endif

	.ActiveSheet.Range('A1:'+cBukva+'1').Select()
	Try
		With .Selection
			.BorderS(5).LineStyle=-4142
			.BorderS(6).LineStyle=-4142
			With .BorderS(7)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(8)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(9)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(10)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(11)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(12)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
		Endwith
	Catch When .T.
	Endtry

	.ActiveSheet.Range('A2:'+cBukva+Transform(nReccount+1)).Select()
	Try
		With .Selection
			.BorderS(5).LineStyle=-4142
			.BorderS(6).LineStyle=-4142
			With .BorderS(7)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(8)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(9)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(10)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(11)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
			With .BorderS(12)
				.LineStyle=1
				.Weight=2
				.ColorIndex=-4105
			Endwith
		Endwith
	Catch When .T.
	Endtry
	.ActiveSheet.Range(.Cells(1,1),.Cells(1,1)).Select()
	.Visible = .T.
endwith

Return oExcel