:: Visual Foxpro, Foxpro for DOS
Re: копирование колонки
Божья_коровка

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

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


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

Сообщений: 25161
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
Ты тоже уже ввязвалась, щас будем вместе заканчивать
Ratings: 0 negative/0 positive
Re: копирование колонки
Божья_коровка

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


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

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

Сообщений: 107
Дата регистрации: 07.07.2020
если нужен был курсор то вот, из него все и уходит в эксель



Исправлено 1 раз(а). Последнее : axeum, 04.08.20 14:50
Ratings: 0 negative/0 positive
Re: копирование колонки
of63

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

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



Исправлено 4 раз(а). Последнее : of63, 04.08.20 15:41
Ratings: 0 negative/1 positive
Re: копирование колонки
axeum
Автор

Сообщений: 107
Дата регистрации: 07.07.2020
правильно,
все ли нужные ячейки в экселе? ДА
колонки в нужном порядке? нет(но это копирование так что думаю пока этот момент мы опускаем)



Исправлено 4 раз(а). Последнее : axeum, 05.08.20 06:07
Ratings: 0 negative/0 positive
Re: копирование колонки
lulgu

Сообщений: 1838
Дата регистрации: 30.11.2016
OFF
Божья_коровка
PS: Сам виноват раз ввязался в тему, так уж заканчивай красиво

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

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

Сообщений: 107
Дата регистрации: 07.07.2020
lulgu
OFF
Божья_коровка
PS: Сам виноват раз ввязался в тему, так уж заканчивай красиво

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

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

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

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

Сообщений: 25161
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
Самый простой перевод в Эксель - вообще без экселя
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

Сообщений: 1838
Дата регистрации: 30.11.2016
...и пол-жизни будешь бросаться на каждый отчет как на амбразуру ...
Ratings: 0 negative/0 positive
Re: копирование колонки
axeum
Автор

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



Исправлено 1 раз(а). Последнее : axeum, 06.08.20 17:33
Ratings: 0 negative/0 positive
Re: копирование колонки
of63

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

Сообщений: 343
Откуда: Лида Беларусь
Дата регистрации: 25.03.2008
* Перевод в 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



Исправлено 2 раз(а). Последнее : LUCIAN, 13.08.20 08:43
Ratings: 0 negative/0 positive


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

On-line: 22 vlgrech  (Гостей: 21)

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