for flooders
:: Главная :: Решения :: Статьи :: Сайт М. Дроздова :: Файловый архив :: Книга по VFP 9 :: Русский Help Online :: OFF-LINE Форум
   Лисоводы   всех   стран,  объединяйтесь !!!  

Список Форумов  :: Visual Foxpro, Foxpro for DOS
  

Re: копирование колонки
Божья_коровка

Сообщений: 23875
Дата: 04.08.20 13:43:41
of63
Может мне сразу ТЗ, данные, оформление на работу, подьемные, премиальные, суточные, удаленку, админский доступ, услуги секретарши... Ага
Без секретарши обойдешься

PS: Сам виноват раз ввязался в тему, так уж заканчивай красиво


------------------
Жись, она как зёбра, полоса белая, полоса черная, а мне всегда задница достается...
Ratings: 0 negative/0 positive

Re: копирование колонки
of63

Сообщений: 20541
Откуда: Н.Новгород
Дата: 04.08.20 13:48:51
Ты тоже уже ввязвалась, щас будем вместе заканчивать
Ratings: 0 negative/0 positive

Re: копирование колонки
Божья_коровка

Сообщений: 23875
Дата: 04.08.20 13:50:29
of63
Ты тоже уже ввязвалась, щас будем вместе заканчивать
Не, не, не у меня работы выше крыши, я вчера только в половину двенадцатого освободилась. Сейчас просто отвлеклась на 5 минут, чтобы выдохнуть и посмотреть чем вы тут занимаетесь. Вы уж как нибудь без меня


------------------
Жись, она как зёбра, полоса белая, полоса черная, а мне всегда задница достается...
Ratings: 0 negative/0 positive

Re: копирование колонки
of63

Сообщений: 20541
Откуда: Н.Новгород
Дата: 04.08.20 13:59:17
А я бездельничаю, жду, кто бы работы подкинул, и тут бац, затейливая задачка про ИТОГО по месяцам! Я сразу за перо Кончать говоришь... Да, пора...
Ratings: 0 negative/0 positive

Re: копирование колонки
axeum
Автор

Сообщений: 48
Дата: 04.08.20 14:46:16
если нужен был курсор то вот, из него все и уходит в эксель



Исправлено: axeum, 04.08.20 14:50
Ratings: 0 negative/0 positive

Re: копирование колонки
of63

Сообщений: 20541
Откуда: Н.Новгород
Дата: 04.08.20 15:28:19
[attachment 33617 cr1.JPG]
Простой курсор! Если его изобразить в экселе:
SELECT cr1  
  COPY TO C:\TMP\cr1 TYPE XL5
то цель будет достигнута? Т.е. все колонки имеют правильное название, две строки данных, заполнены из двух строк курсора, ячейка в ячейку?
Да? (Ну, допустим колонку NLS,KKD изображать в экселе не надо, но мы пока про замнем, речь про колонки ФИО, адрес, M0000091 и правее)

Если не да, то какой файл экселя должен соответствовать этому курсору cr1 ?



Исправлено: of63, 04.08.20 15:41
Ratings: 0 negative/1 positive

Re: копирование колонки
axeum
Автор

Сообщений: 48
Дата: 05.08.20 05:19:17
правильно,
все ли нужные ячейки в экселе? ДА
колонки в нужном порядке? нет(но это копирование так что думаю пока этот момент мы опускаем)



Исправлено: axeum, 05.08.20 06:07
Ratings: 0 negative/0 positive

Re: копирование колонки
lulgu

Сообщений: 1751
Дата: 06.08.20 13:38:04
OFF
Божья_коровка
PS: Сам виноват раз ввязался в тему, так уж заканчивай красиво

Почти как в постели.

И все же - как красиво выводить отчеты в Excel?
Ratings: 0 negative/0 positive

Re: копирование колонки
axeum
Автор

Сообщений: 48
Дата: 06.08.20 13:46:16
lulgu
OFF
Божья_коровка
PS: Сам виноват раз ввязался в тему, так уж заканчивай красиво

Почти как в постели.

И все же - как красиво выводить отчеты в Excel?
Тоже ожидаю дальнейшего ответа, но пока жду я походу и см нашёл свою проблему(там была в самом начале ошибка в условии иф исправив которую почти все само собой заработало)
Ratings: 0 negative/0 positive

Re: копирование колонки
of63

Сообщений: 20541
Откуда: Н.Новгород
Дата: 06.08.20 14:20:56
Я не понял, вы от меня что-то ждете? Всё уже есть! Курсор есть (ТС сказал, что курсор правильный), еще и в Эксель его перенести, ячейка в ячейку, на блюдечке с голубой каёмочкой?!
Ratings: 0 negative/0 positive

Re: копирование колонки
axeum
Автор

Сообщений: 48
Дата: 06.08.20 15:56:17
Лично для меня самые 2 основные проблемы были это курсор с динамическими колонками и его вывод эксель, хоть они уже и не актуальны но все же хотелось бы посмотреть на тот код который сможет такой курсор правильно перенести в эксель
P.s. Сегодня отчёт дописал(клиент рад как ребёнок ) спасибо огромное за помощь, много чего для себя нового узнал
Ratings: 0 negative/0 positive

Re: копирование колонки
of63

Сообщений: 20541
Откуда: Н.Новгород
Дата: 06.08.20 16:42:52
Самый простой перевод в Эксель - вообще без экселя
COPY TO (файл) TYPE XL5
но к сожалению в формате Эксель-95

Перетусовать, переиментовать колонки
SELECT ... FROM cr1 INTO CURSOR cr2
... - это список изображаемых колонок, и переименование - Имя1 AS Имя2

Сделать Эксель посовременнее - запускай сам эксель oExcel = CREATEOBJECT("Excel.Application") и наполняй его как руками, заполняя каждую ячйку программно.

И еще есть 33 и 1/3 способов, но сделай (уже сделал) таким, который устраивает заказчика. Дальше в читальном зале изучай, гугли, экспериментируй. Всё знать не обязательно, достаточно экзаменационного минимума для сдачи предмета, а потом само придёт по мере необходимости и упёрства )
Ratings: 0 negative/0 positive

Re: копирование колонки
lulgu

Сообщений: 1751
Дата: 06.08.20 17:21:27
...и пол-жизни будешь бросаться на каждый отчет как на амбразуру ...
Ratings: 0 negative/0 positive

Re: копирование колонки
axeum
Автор

Сообщений: 48
Дата: 06.08.20 17:33:26
lulgu
...и пол-жизни будешь бросаться на каждый отчет как на амбразуру ...
ну почему же? сложно только в 1 раз когда с этим сталкиваешься и еще пока не знаешь как сделать, я пол года назад на обычную справку месяц потратил бы а сейчас есди и сложная справка пол дня максимум и готово , как только ставишь галочку сделано на трудном отчете/справке/форме в след раз уже в разы меньше времени тратишь и просто знаешь как что где то сделать главное ведь это опыт



Исправлено: axeum, 06.08.20 17:33
Ratings: 0 negative/0 positive

Re: копирование колонки
of63

Сообщений: 20541
Откуда: Н.Новгород
Дата: 06.08.20 18:04:17
Главное опыт? Может быть. Все главное в процессе познавания мира, или фокса.
У меня "главное" (мания) оформить знаение в подпрограмму (или класс, или хотя бы записать мысль в комментарии). В результате программу читать не возможно не прочитав "словарик" - список подпрограмм (функций, классов), которые использованы в коде. Вобщем кто как получает удовольствие от программерства... а без удовольствия, без зуда "всё улучшить", получается плохо, когда не "прёт" от процесса решения задачи, то говорят "не твоё"...
Ratings: 0 negative/0 positive

Re: копирование колонки
LUCIAN

Сообщений: 339
Откуда: Лида Беларусь
Дата: 12.08.20 17:04:06
* Перевод в 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



Исправлено: LUCIAN, 13.08.20 08:43
Ratings: 0 negative/0 positive



Извините, только зарегистрированные пользователи могут оставлять сообщения в этом форуме.

On-line: 11 medstrax  (Гостей: 10)

25.01.2021 19:29:17 exec: 0.12
Mem: 1.431 Mb

© 2000-2021 Fox Club 
Яндекс.Метрика