Форум » [x]Harbour » excel » Ответить

excel

valery2: Хотелось-бы узнать, есть-ли эффективный ( быстрый ) способ экспорта dbf -> xls? Реальный!

Ответов - 49, стр: 1 2 3 All

valery2: Уточняю. У моих конкурентов - Delphi - берем примерно 10000 записей: 3-4 сек., у меня: 1.5 мин !!!!!!

valery2: Читал другие форумы- везде, что-то, нужно использовать кривое, чужое и т. п.. А у нас ?

valery2: Небожители - АУ !!!!!!!!


Петр: Что хотим экспортировать, структура таблицы. И каким способом делаем это сейчас?

valery2: Что-угодно ( прайс, база номенклатуры, накладные и т. д. и т.п. ). Пользуюсь : oExcel := TOleAuto():New( "Excel.Application" ) if Ole2TxtError() != 'S_OK' MsgStop('Excel is not available!', PROGRAM ) RETURN endif oExcel:Visible := .F. oExcel:WorkBooks:Add() oSheet := oExcel:Get( "ActiveSheet" ) Aeval( (cAlias)->( DBstruct(cAlias) ), { |e,i| oSheet:Cells( nCell, i ):Value := e[DBS_NAME] } ) do while !(cAlias)->( EoF() ) nCell++ aColumns := (cAlias)->( Scatter() ) aEval( aColumns, { |e,i| oSheet:Cells( nCell, i ):Value := e } ) (cAlias)->( DBskip() ) enddo oBook := oExcel:Get("ActiveWorkBook") oBook:Title := cAlias oBook:Subject := cAlias oBook:SaveAs(cFile) oExcel:Quit() из MiniGUI\SAMPLES\Applications\DBFview

Петр: Реализация OLE в Harbour не очень быстрая. Если действительно нужна скорость выгрузки, можно использовать прямую запись в файл. Естественно структура xls 2003 или 2007 сложная. Но в сети довольно много примеров генерации файлов biff 2.1 (до Excel 5.0). Такой файл легко открывается всеми версиями Excel - от 97 до 2007. К тому же такой способ можно использовать на компьютере без установленного MS Office. Если же Excel установлен, то просто открываем такой файл и сохраняем в более современной версии.

valery2: Но ведь это - не метод. Вы мудрые где-тож - чего-тож уже надыбали поделитесь А если без шуток - опять у нас нет решения на простые для других вопросы

Петр: valery2 пишет: Но ведь это - не метод.. Что значит не метод? И что значит - опять у нас нет решения на простые для других вопросы?

Pasha: valery2 пишет: поделитесь В сырцах TSBrowse есть метод Excel2 - из грида формируется документ xls Можно его использовать, конечно, модифицировав для данного случая

valery2: Pasha пишет: В сырцах TSBrowse есть метод Excel2 - из грида формируется документ xls Можно его использовать, конечно, модифицировав для данного случая Спасбо! Честное слово. Но там же работы - на неделю, а доводка - на месяц(ы) Неужели никто реально не решал эту проблемму ? Потом, TSBrowse - с ним тоже пробовал. Результат - тот-же. Может я что-то не так ?

Петр: valery2 пишет: Неужели никто реально не решал эту проблемму ? Боюсь, что ни у кого таких глобальных проблем не возникало. Откройте любую базу, сделайте COPY TO temp.xls DELIMITED WITH TAB откройте в Excel вновь созданный temp.xls Используйте OLE вместо "напильника" Получите тот же результат oExcel := TOleAuto():New( "Excel.Application" ) if Ole2TxtError() != 'S_OK' MsgStop('Excel is not available!', PROGRAM ) RETURN endif oExcel:Visible := .F. oExcel:WorkBooks:Add() oSheet := oExcel:Get( "ActiveSheet" ) Aeval( (cAlias)->( DBstruct(cAlias) ), { |e,i| oSheet:Cells( nCell, i ):Value := e[DBS_NAME] } ) do while !(cAlias)->( EoF() ) nCell++ aColumns := (cAlias)->( Scatter() ) aEval( aColumns, { |e,i| oSheet:Cells( nCell, i ):Value := e } ) (cAlias)->( DBskip() ) enddo oBook := oExcel:Get("ActiveWorkBook") oBook:Title := cAlias oBook:Subject := cAlias oBook:SaveAs(cFile) oExcel:Quit() но гораздо быстрее. P.S. Реализация метода Excel 2 в TSBrowse - это та же генерация файла biff 2.1.

valery2: Вот за ЭТО - СПАСИБО !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

valery2: Прошу пощения, но опять непонятки. Я, мягко говоря, не спец ни с excel, ни с ole.Петр пишет: сделайте COPY TO temp.xls DELIMITED WITH TAB откройте в Excel вновь созданный temp.xls сделал Петр пишет: Используйте OLE вместо "напильника" а вот тут - я тупорылый. temp.xls - ведь текстовый. И что сним делать ?

Andrey: valery2 пишет: а вот тут - я тупорылый. temp.xls - ведь текстовый. И что сним делать ? Открывай его в Екселе вплоть до: RUN excel temp.xls Или через Оле вызывать Ексел и открывать этот файл. Пример можете смотреть в ?:\xHarbour\tests\testole.prg Успехов ....

valery2: Открывается-то элементарноoExcel:WorkBooks:Open( CurDrive() + ":\" + curdir()+"\temp.xls" ) А вот дальше... Дохожу до oBook:SaveAs(kyda+"\ttt.xls") Сыплются запросы на сохранение, замену. Забыл сказать: вначале oExcel:Visible := .F. Нужно, чтобы весь просесс был скрытым для юзера. А - oBook:SaveAs(kyda+"\ttt.xls") - сначала задает вопрос "сохранить ttt.xls", затем сообщает, что такой уже есть ( он успел уже кинуть туда ttt.xls, но с текстовыми потрохами), потом выдет putfile, с установками на txt, и, только, указав все атрибуты, получаю нужное. Нужно-то все молча.

valery2: Вот текст :procedure dbxls(kyda) Local oExcel, oSheet, oBook oExcel := TOleAuto():New( "Excel.Application" ) if Ole2TxtError() != 'S_OK' MsgStop('Excel не найден!') RETURN endif COPY TO temp.xls DELIMITED WITH TAB oExcel:Visible := .F. oExcel:WorkBooks:Open( CurDrive() + ":\" + curdir()+"\temp.xls" ) oSheet := oExcel:Get( "ActiveSheet" ) oBook := oExcel:Get("ActiveWorkBook") oBook:SaveAs(kyda+"\ttt.xls") oExcel:Quit() return Где-что-нитак?

Andrey: valery2 пишет: сначала задает вопрос "сохранить ttt.xls", затем сообщает, что такой уже есть ( он успел уже кинуть туда ttt.xls, но с текстовыми потрохами), потом выдет putfile, с установками на txt, и, только, указав все атрибуты, получаю нужное. Перед записью в ttt.xls удаляй сам такой файл, не надейся на ЕКСЕЛЬ !!! И посмотри здесь на форуме как сохранить файл для WORD'a - технология одна ОЛЕ !!!

valery2: Andrey пишет: Перед записью в ttt.xls удаляй сам такой файл, не надейся на ЕКСЕЛЬ !!! Посмотрите на мою проц - в этом вся загвоздка!!!!! Перед oBook:SaveAs(kyda+"\ttt.xls") ничего не происходит! Вот далее - все то, что перечисленно выше. Удалять-то нечего!?

valery2:

valery2: Нашел на форуме SaveAs(FileName, FileFormat, LockComments, Password, AddToRecentFiles, WritePassword, ReadOnlyRecommended, EmbedTrueTypeFonts, SaveNativePictureFormat, SaveFormsData, SaveAsAOCELetter, Encoding, InsertLineBreaks, AllowSubstitutions, LineEnding, AddBiDiMarks) Но, если с 1-м параметром все ясно, 2-й ---- не знаю что подставить- все ошибка. За 3-й еще не брался.

Andrey: Даю для WORD свою функции, далее сам пробуй. ****************************************** #define wdFormatDocument 0 FUNCTION WORD2OPEN(cFileTxt,cFileDoc) LOCAL oWord, oDocs, oActive, oSelect, oMarks TRY oWord := GetActiveObject( "Word.Application" ) CATCH TRY oWord := CreateObject( "Word.Application" ) CATCH Alert( "ERROR ! Ms WinWord not system. [" + Ole2TxtError() + "]" ) RETURN NIL END END oWord := TOleAuto():New( "Word.Application" ) oDocs := oWord:Documents oDocs:Open( cFileTxt, .f., .f., .f., "", "", .f., "", "", 0,"866") oWord:ActiveDocument:SaveAs( cFileDoc, wdFormatDocument ) oWord:Visible := .T. oWord:WindowState := 1 // Maximize RETURN NIL

gustow: Вот мне поставили коллеги задачу - перевести кучу DBF в кучу XLS (с теми же именами и добавляя заголовки столбцов; да еще нарисовать "решетку" и пр. красивости). Сляпал такое (под свои нужды, разберяся, смодифицируешь, думаю - на мои "специфические" заморочки и закомментенные отладочные куски не обращай внимания, делай "под себя" :) ). Это из того, что тебе вроде и надо, разряда - "практических" задач. Конечно, "гуры", наверное, сделали бы покрасивше... но, главное, пашет! Если что - черкай на gustow33 @ mail.ru P.S. Кстати, тут самой "времязатратной" операцией стало, как ни странно,... установка параметров страницы (точнее - установка отступов от краев листа); и почему Excel (да и Word) делает именно это _так_ долго?? Может, кто-нибудь из "более в теме" разобъяснит, как это "побороть"? --------- begin ------------ /* перевод "кучи DBF в кучу XLS" с теми же именами */ /* с фиксированной структурой - имена полей заменяем на рус.заголовки */ /* изменения: 2008.03.04 - НЕ выводить поле "Торговое наименование (рус.)" "NAME_MED" 2008.03.13 - выводить! 2008.04.09 - исправлена ошибка в выборе папки (если выбираем подпапку прежней) 2008.04.21 - добавлен check-box "Обрабатывать подпапки" 2008.04.29 - добавлен check-box "Удалять DBF-файлы" */ #include "minigui.ch" #include "dbstruct.ch" #include "fileio.ch" #include "error.ch" REQUEST HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866 REQUEST DBFNTX **************************** function MAIN private pap1:=GetCurrentFolder(), pap2:=GetCurrentFolder(), koldbf:=0 set language to RUSSIAN hb_SetCodepage( "RU1251" ) set delete on set browsesync on set century on set date BRITISH set font to 'Arial', 10 DEFINE WINDOW Win_1 ; AT 0,0 ; WIDTH 600 HEIGHT 400 ; TITLE "Пакетный перевод .DBF в .XLS (вер. 2.1)" ; MAIN @ 22, 40 LABEL pa1 OF Win_1 VALUE "DBF:" @ 20, 80 GETBOX papk1 OF Win_1 HEIGHT 22 WIDTH 400 VALUE pap1 @ 20, 485 BUTTON bpa1 OF Win_1 ; CAPTION "..." ACTION Papka(1) ; WIDTH 40 HEIGHT 22 DEFINE CHECKBOX podpap ROW 50 COL 80 WIDTH 240 CAPTION "Обрабатывать подпапки" VALUE .F. TOOLTIP 'Обрабатывать DBF-ы и во вложенных папках' ONCHANGE LKolUpd() END CHECKBOX DEFINE CHECKBOX dbf_udal ROW 50 COL 340 WIDTH 240 CAPTION "Удалять DBF-файлы" VALUE .F. TOOLTIP 'Удалять DBF-файлы после обработки' ONCHANGE Nil /* LKolUpd() */ END CHECKBOX @ 80, 80 LABEL lkol VALUE "" WIDTH 400 @ 112, 40 LABEL pa2 OF Win_1 VALUE "XLS:" @ 110, 80 GETBOX papk2 OF Win_1 HEIGHT 22 WIDTH 400 VALUE pap2 @ 110, 485 BUTTON bpa2 OF Win_1 ; CAPTION "..." ACTION Papka(2) ; HEIGHT 22 WIDTH 40 @ 150, 80 BUTTON gogo OF Win_1 ; CAPTION "Начать преобразование DBF->XLS" ACTION Rabota() ; HEIGHT 22 WIDTH 300 @ 180, 100 LABEL sdelano VALUE "" WIDTH 440 END WINDOW LKolUpd() CENTER WINDOW Win_1 ACTIVATE WINDOW Win_1 return NIL *------- function Papka(par) local papold, patmp papold:=pap1 if par=1 patmp:=GetFolder("Выберите папку с .DBF-файлами", pap1) if EMPTY(patmp) return Nil endif pap1:=patmp // if pap1<>papold if (pap1 # papold) .or. (pap1=papold .and. len(pap1)<>len(papold)) pap2:=pap1 Win_1.papk1.Value:=pap1 Win_1.papk2.Value:=pap2 LKolUpd() endif else papold:=pap2 patmp:=GetFolder("Выберите папку, куда сохранить .XLS-файлы", pap2) if EMPTY(patmp) return Nil endif pap2:=patmp // if pap2<>papold if (pap2 # papold) .or. (pap2=papold .and. len(pap2)<>len(papold)) Win_1.papk2.Value:=pap2 endif endif return Nil *------- function LKolUpd() // koldbf:=adir(pap1+"\*.dbf") // было до 2008-04-21 /// кусок с возможностью обработки подпапок koldbf:=0 if Win_1.podpap.Value = .F. // НЕ обрабатывать подпапки koldbf:=adir(pap1+"\*.dbf") else PodPapDbf() // ищем DBFы в текущей и ПОДпапках endif /// if koldbf>0 Win_1.lkol.Value:="Количество DBF-файлов в папке: "+ltrim(str(koldbf)) Win_1.gogo.Show() else Win_1.lkol.Value:="В папке НЕ обнаружены DBF-файлы!" Win_1.gogo.Hide() endif return Nil *------- function PodPapDbf() * ищем DBFы в текущей и под-папках local kk, kk1, aa, i kk1:=0 kk:=0 kk1:=adir(pap1+"\*.dbf") // в текущей kk:=kk+kk1 /* MsgInfo("kk1="+str(kk1)+CRLF+; "kk="+str(kk)) */ do while .t. aa:=directory(pap1+"\*.*", "D") // список всех файлов, включая ПОДпапки if len(aa)>0 for i:=1 to len(aa) if aa[i, 5]="D" .and. aa[i, 1]<>".." .and. aa[i, 1]<>"." kk1:=adir(pap1+"\"+aa[i, 1]+"\*.dbf") // ищем DBFы в ПОДпапке kk:=kk+kk1 /* MsgInfo("aa[i, 1]="+aa[i,1]+CRLF+; "kk1="+str(kk1)+CRLF+; "kk="+str(kk)) */ endif next i endif aa:={} exit // весь DO WHILE - переделать для рекурсии enddo koldbf:=kk return Nil *------- function Rabota() local aa, i, i2, laa, nn, aa1, aa2 private oExcel // aa:=directory(pap1+"\*.dbf") // было до 2008-04-22 // кусок с возможностью обработки подпапок aa:={} if Win_1.podpap.Value = .F. // НЕ обрабатывать подпапки aa:=directory(pap1+"\*.dbf") else aa1:=directory(pap1+"\*.dbf") // DBFы из головной папки if len(aa1)>0 for i:=1 to len(aa1) aadd(aa, aa1) next i endif aa1:=directory(pap1+"\*.*", "D") // список всех файлов, включая ПОДпапки if len(aa1)>0 for i:=1 to len(aa1) if aa1[i, 5]="D" .and. aa1[i, 1]<>".." .and. aa1[i, 1]<>"." aa2:=directory(pap1+"\"+aa1[i, 1]+"\*.dbf") // ищем DBFы в ПОДпапке if len(aa2)>0 for i2:=1 to len(aa2) ** добавляем "имя_подпапки\имя_базы.DBF" (и остальные элементы) aadd(aa, {aa1[i,1]+"\"+aa2[i2, 1], aa2[i2, 2], aa2[i2, 3], aa2[i2, 4], aa2[i2, 5] }) next i2 endif endif next i endif endif // laa:=len(aa) Win_1.sdelano.Value:="Загружаю Excel" // перенес сюда из SaveToXls oExcel := TOleAuto():New( "Excel.Application" ) if Ole2TxtError() != 'S_OK' MsgStop('Excel is not available!', PROGRAM ) RETURN endif oExcel:Visible := .F. *oExcel:Visible := .T. // for i:=1 to laa Win_1.sdelano.Value:="Обрабатывается "+ltrim(str(i))+" из "+ltrim(str(laa))+" DBF-файлов ("+aa[i,1]+")" nn:=left(aa[i,1], len(aa[i,1])-4) // имя файла (без ".DBF") use ( pap1+"\"+nn ) alias RRR new codepage "RU866" // SaveToXls("RRR", pap2+"\"+lower(nn)+".xls") // было до 2008-04-22 // кусок с возможностью обработки подпапок if Win_1.podpap.Value = .F. // НЕ обрабатывать подпапки SaveToXls("RRR", pap2+"\"+lower(nn)+".xls") else // при подпапках - сохраняем в // подпапки той же PAP1 SaveToXls("RRR", pap1+"\"+lower(nn)+".xls") endif close RRR // &nn // кусок с возможностью удаления DBF-файлов после обработки if Win_1.dbf_udal.Value = .T. // удалять if filedelete( pap1+"\"+nn+".dbf" ) = .F. MsgInfo("Почему-то не могу удалить файл"+CRLF+; pap1+"\"+nn+".dbf" ) endif endif // next i Win_1.sdelano.Value:="Убиваю Excel (в памяти)" // oExcel:Quit() //// oExcel:End() // начиная с HMG v1.5 не нужно // GAL //// OleUninitialize() // !!! проканало !!! "Excel" убивается !!! // из MiniGUI\SOURCE\TsBrowse\h_tbrowse.prg // это внутри (в конце) этого // METHOD TSBrowse:ExcelOle() // начиная с HMG v1.5 не нужно // Win_1.sdelano.Value:="" MsgInfo('"Дело сделано!" - сказал слепой...'+CRLF+CRLF+; ' (c) Р.Л.Стивенсон - "Остров сокровищ"') close databases return Nil *--------------------------------------------------------* Static Procedure SaveToXls( cAlias, cFile ) *--------------------------------------------------------* * Local oExcel, oSheet, oBook, aColumns, nCell := 1 Local oSheet, oBook, aColumns, nCell:=1, nCell0, lrpole local ij, dbs, zap, cMemo, oRan, np, nGr, nGrAdr:=999, nSh // GAL local lAdrApt // выводить ли колонку ADR_APT ("Адрес аптеки") private ; xlTop:=-4160, xlCenter:=-4108, xlBottom:=-4107, ; xlLeft:=-4131, xlRight:=-4152, ; xlEdgeTop:=8, xlEdgeBottom:=9, xlEdgeLeft:=7, xlEdgeRight:=10, ; xlInsideVertical:=11, xlInsideHorizontal:=12, ; xlDiagonalUp:=6, xlDiagonalDown:=5, ; xlNone:=-4142, ; // граница - "нет линии" xlContinuous:=1, ; // граница - "сплошная линия" xlThin:=2, ; // граница - "тонкая линия" xlHairline:=1, ; // граница - "точками" xlAutomatic:=-4105, ; // граница - "цвет линии автоматом" xlLandscape:=2 // ориентация страницы - "альбомная" nSh:=0 // ширина колонки lAdrApt:=.T. // по умолчанию - выводить "Адрес аптеки" dbs:=(cAlias)->( DBstruct(cAlias) ) // GAL /* oExcel := TOleAuto():New( "Excel.Application" ) if Ole2TxtError() != 'S_OK' MsgStop('Excel is not available!', PROGRAM ) RETURN endif oExcel:Visible := .F. *oExcel:Visible := .T. */ oExcel:WorkBooks:Add() oSheet := oExcel:Get( "ActiveSheet" ) oSheet:PageSetup:Orientation := xlLandscape lrpole:= oExcel:Application:InchesToPoints(0.393700787401575) // верхнее поле страницы - 1 см oSheet:PageSetup:TopMargin := lrpole // нижнее поле страницы - 1.7 см oSheet:PageSetup:BottomMargin := 1.7 * lrpole // левое, правое поля страницы - по 0.7 см oSheet:PageSetup:LeftMargin := 0.7 * lrpole oSheet:PageSetup:RightMargin := 0.7 * lrpole // колонтитул (внизу в центре) oSheet:PageSetup:CenterFooter := "Страница &С из &К" // вместо &P и &N // заголовок таблицы oSheet:Cells( 1, 1 ):Value := "Информация о наличии ЛС в аптеке" * Aeval( (cAlias)->( DBstruct(cAlias) ), { |e,i| oSheet:Cells( nCell, i ):Value := e[DBS_NAME] } ) nCell:=3 // шапку таблицы начинаем с 3-й строки for i:=1 to len(dbs) do case case dbs[i,1]="C_TRN" ; np:="Код ЛС по торговому наимено-ванию"; nSh:=10 case dbs[i,1]="NAME_MED" ; np:="Торговое наименование ЛС (рус.)" ; nSh:=16 case dbs[i,1]="NAME_TRN_L"; np:="Торговое наименование ЛС (лат.)" ; nSh:=16 case dbs[i,1]="C_MNN" ; np:="Код ЛС по МНН" ; nSh:=7 case dbs[i,1]="NAME_MNN_R"; np:="МНН (рус.)" ; nSh:=16 case dbs[i,1]="NAME_MNN_L"; np:="МНН (лат.)" ; nSh:=16 case dbs[i,1]="C_LF" ; np:="Код лекарст-венной формы" ; nSh:=10 case dbs[i,1]="NAME_LF" ; np:="Наимено-вание лекарств. формы (рус.)"; nSh:=10 case dbs[i,1]="NAME_LF_L" ; np:="Наимено-вание лекарств. формы (лат.)"; nSh:=10 case dbs[i,1]="DOZ_LS" ; np:="Дозиро-вка, единица измерения дозировки"; nSh:=10 case dbs[i,1]="D_LS" ; np:="Дозиро-вка действующего вещества" ; nSh:=10 case dbs[i,1]="NAME_DLS" ; np:="Лат. наимено-вание ед. изм." ; nSh:=10 case dbs[i,1]="OSTATOK" ; np:="Остаток ЛС" ; nSh:=8 case dbs[i,1]="A_COD" ; np:="ОГРН аптеки + код аптеки" ; nSh:=10 case dbs[i,1]="APTEK" ; np:="Аптека" ; nSh:=10 case dbs[i,1]="ADR_APT" ; np:="Адрес аптеки" ; nSh:=12 lAdrApt:=iif(empty((cAlias)->ADR_APT),.F.,.T.) // если в 1-й записи поле пустое - не выводить case dbs[i,1]="OTSROCH" ; np:="Отсроченные" ; nSh:=10 case dbs[i,1]="NOMK_LS" ; np:="Номен-кла-турный код ЛС" ; nSh:=9 case dbs[i,1]="DAT" ; np:="Дата наличия остатка" ; nSh:=8.5 // otherwise; np:="" endcase nGr:=i if lAdrApt=.F. if dbs[i,1]="ADR_APT" // не выводить заголовок графы "Адрес аптеки" nGrAdr:=i // N поля в структуре базы (N графы) loop endif nGr:=iif(i<nGrAdr, nGr, nGr-1) endif oSheet:Cells( nCell, nGr ):Value := np // заголовок графы oRan := oSheet:Range( chr(asc("A")+nGr-1) + "3:" + ; chr(asc("A")+nGr-1) + "3" ) oRan:ColumnWidth := nSh // ширина ячеек // колонтитул (мини-шапка для печати на каждой странице) oSheet:Cells( nCell+1, nGr ):Value := ltrim(str(nGr)) next i nCell:=0 nCell0:=5 // а саму таблицу начинаем с 5-й строки cMemo:="" do while !(cAlias)->( EoF() ) nCell++ aColumns := (cAlias)->( Scatter() ) for i:=1 to len(aColumns) // 20080310 - НЕ выводить "Адрес аптеки" "ADR_APT", // если в 1-й записи поле пустое if dbs[i,1]="ADR_APT" .and. (.not. lAdrApt) loop endif // cMemo += iif(i=1,"",chr(9)) do case case dbs[i,2]="C" if dbs[i,1] = "APTEK" cMemo += strtran(trim(aColumns), " "+chr(252), " "+chr(185)) // в "Аптека" заменять // " ь" -> " №" (" "+No) else cMemo += trim(aColumns) endif case dbs[i,2]="D"; cMemo += dtoc(aColumns) case dbs[i,2]="N" zap:=str(aColumns, dbs[i,3], dbs[i,4] ) if dbs[i,4]>0 zap:=strtran(zap, ".", ",") endif zap:=ltrim(zap) cMemo += zap endcase next i cMemo += chr(10) // (cAlias)->( DBskip() ) enddo CopyToClipboard( cMemo ) oSheet:Cells( nCell0, 1 ):Select() oSheet:paste() for i:=1 to len(dbs) if dbs[i,4]>0 // "N", есть разряды после запятой oRan := oSheet:Range( chr(asc("A")+i-1) + ltrim(str(nCell0)) + ":" + ; chr(asc("A")+i-1) +ltrim(str(nCell0+nCell-1)) ) oRan:NumberFormat := replicate("#", dbs[i,3]-dbs[i,4]-2)+"0,"+replicate("0",dbs[i,4]) // oSheet:Cells( nCell, i ):NumberFormat := replicate("#", dbs[i,3]-dbs[i,4]-2)+"0,"+replicate("0",dbs[i,4]) // oCell:NumberFormat := "#######0,00" endif next i oRan := oSheet:Range( "A" + ltrim(str(nCell0)) + ":" + ; chr(asc("A")+nGr-1) +ltrim(str(nCell0+nCell-1)) ) oRan:Font:Name := "Arial Cyr" oRan:Font:Size := 10 oRan:WrapText := .T. // перенос текста по словам oRan:VerticalAlignment := xlTop oRan:Rows:AutoFit() // выставляем АВТОвысоту граф // рамки для списка ("точками" - xlHairline) oRan:Borders(xlDiagonalDown):LineStyle := xlNone oRan:Borders(xlDiagonalUp):LineStyle := xlNone /* oRan:Borders(xlEdgeLeft):LineStyle := xlContinuous oRan:Borders(xlEdgeLeft):Weight := xlHairline oRan:Borders(xlEdgeLeft):ColorIndex := xlAutomatic */ oRan_Bord( oRan:Borders(xlEdgeLeft ), xlContinuous, xlHairline, xlAutomatic ) oRan_Bord( oRan:Borders(xlEdgeTop ), xlContinuous, xlHairline, xlAutomatic ) oRan_Bord( oRan:Borders(xlEdgeBottom), xlContinuous, xlHairline, xlAutomatic ) oRan_Bord( oRan:Borders(xlEdgeRight ), xlContinuous, xlHairline, xlAutomatic ) oRan_Bord( oRan:Borders(xlInsideVertical), xlContinuous, xlHairline, xlAutomatic ) if nCell>1 // в таблице больше одной строки oRan_Bord( oRan:Borders(xlInsideHorizontal), xlContinuous, xlHairline, xlAutomatic ) endif // выделяем заголовок oRan := oSheet:Range( "A3:"+chr(asc("A")+nGr-1)+"4" ) // было len(dbs) oRan:Font:Name := "Arial Cyr" oRan:Font:Size := 10 oRan:Font:Bold := .T. // шрифт - полужирный oRan:WrapText := .T. // перенос текста по словам // центрируем заголовок oRan:HorizontalAlignment := xlCenter oRan:VerticalAlignment := xlCenter oRan:Rows:AutoFit() // выставляем АВТОвысоту граф // рамки для заголовка oRan:Borders(xlDiagonalDown):LineStyle := xlNone oRan:Borders(xlDiagonalUp):LineStyle := xlNone /* oRan:Borders(xlEdgeLeft):LineStyle := xlContinuous oRan:Borders(xlEdgeLeft):Weight := xlThin oRan:Borders(xlEdgeLeft):ColorIndex := xlAutomatic */ oRan_Bord( oRan:Borders(xlEdgeLeft ), xlContinuous, xlThin, xlAutomatic ) oRan_Bord( oRan:Borders(xlEdgeTop ), xlContinuous, xlThin, xlAutomatic ) oRan_Bord( oRan:Borders(xlEdgeBottom), xlContinuous, xlThin, xlAutomatic ) oRan_Bord( oRan:Borders(xlEdgeRight ), xlContinuous, xlThin, xlAutomatic ) oRan_Bord( oRan:Borders(xlInsideVertical ), xlContinuous, xlThin, xlAutomatic ) oRan_Bord( oRan:Borders(xlInsideHorizontal), xlContinuous, xlThin, xlAutomatic ) // печать мини-шапки (с цифирями по центру) на каждой странице oSheet:PageSetup:PrintTitleRows = "$4:$4" // выделяем заголовок ВСЕЙ таблицы oRan := oSheet:Range( "A1:"+chr(asc("A")+nGr-1)+"1" ) oRan:Font:Name := "Arial Cyr" oRan:Font:Size := 12 oRan:Font:Bold := .T. // шрифт - полужирный oRan:HorizontalAlignment := xlCenter oRan:VerticalAlignment := xlTop oRan:Merge() oSheet:Cells( 2, 1 ):Select() oBook := oExcel:Get("ActiveWorkBook") oBook:Title := cAlias oBook:Subject := cAlias oBook:SaveAs(cFile) // GAL //// oSheet:End() // начиная с HMG v1.5 не нужно oBook:Close() //// oBook:End() // начиная с HMG v1.5 не нужно // * oExcel:Quit() * oExcel:End() Return *--------------------------------------------------------* Static Function oRan_Bord( oO, gLineStyle, gWeight, gColorIndex ) *--------------------------------------------------------* /* замена для: oRan:Borders(xlEdgeLeft):LineStyle := xlContinuous oRan:Borders(xlEdgeLeft):Weight := xlHairline oRan:Borders(xlEdgeLeft):ColorIndex := xlAutomatic */ /* пример вызова oRan_Bord( oRan:Borders(xlEdgeLeft), xlContinuous, xlHairline, xlAutomatic ) */ if oO = Nil; return; endif if gLineStyle <> Nil oO:LineStyle := gLineStyle else oO:LineStyle := xlNone endif if gWeight <> Nil oO:Weight := gWeight endif if gColorIndex <> Nil oO:ColorIndex := gColorIndex endif Return Nil *--------------------------------------------------------* Static Function Scatter() *--------------------------------------------------------* Local aRecord[fcount()] return aeval( aRecord, {|x,n| aRecord[n] := FieldGet( n ) } ) *--------------------------------------------------------* Static Function Gather( paRecord ) *--------------------------------------------------------* return aeval( paRecord, {|x,n| FieldPut( n, x ) } ) *------- function Tst() return NIL --------- end --------------

valery2: Andrey пишет: Даю для WORD свою функции, далее сам пробуй. Большое спасибо, попробовал. Все-равно вываливается.Error 1666932/3 DISP_E_MEMBERNOTFOUND: SAVEAS Called from TOLEAUTO:SAVEAS(0) Хотолось-бы понять, какие значения принимает 2-й параметр в SaveAs()? Или я вообще не туда рою?!!

Петр: 2-й параметр в SaveAs определяется как xlFileFormat и может принимать, к примеру, значения xlWJ3 (40) или xlExcel9795 (43). О том, как работать с Object Browser где-то на форуме уже писали.

valery2: Петр пишет: 2-й параметр в SaveAs определяется как xlFileFormat и может принимать, к примеру, значения xlWJ3 (40) или xlExcel9795 (43). Огромное спасибо - ЗАРАБОТАЛО !!! Спасибо всем окликнувшимся !!! #define xlExcel9795 43 procedure dbxls(kyda) Local oExcel, oSheet, oBook oExcel := TOleAuto():New( "Excel.Application" ) if Ole2TxtError() != 'S_OK' MsgStop('Excel не найден!') RETURN endif COPY TO temp.xls DELIMITED WITH TAB oExcel:Visible := .F. oExcel:WorkBooks:Open( CurDrive() + ":\" + curdir()+"\temp.xls" ) oSheet := oExcel:Get( "ActiveSheet" ) oBook := oExcel:Get("ActiveWorkBook") oBook:SaveAs(kyda+"\ttt.xls", xlExcel9795) oExcel:Quit() return Осталось решить (проверить) 2 вещи: 1- насколько это совместимо в других весиях Excel; 2- в dbf есть символьные поля, заполненные цифрами со значащими нулями слева. При таком переводе в xls - поле "общее", нули - теряются. А так, скорость впечатляет !!!

valery2: Петр пишет: О том, как работать с Object Browser где-то на форуме уже писали. Нашел Ваш диалог с Andrey Как использовать DOC-файл в качестве шаблона ? Пошел Вашими рекомендациями , только в Excel. Нашел библиотеку, класс и т.д. Но там только перечисление параметров, а какие они могут принимать значения ? Где искать ?

Петр:

valery2: Спасибо, Петр. Но проблемма не в этом. Я хочу разобраться со всеми параметрами:SaveAs([Filename], [FileFormat], [Password], [WriteResPassword], [ReadOnlyRecommended], [CreateBackup], [AccessMode As XlSaveAsAccessMode = xlNoChange], [ConflictResolution], [AddToMru], [TextCodepage], [TextVisualLayout], [Local]) Т.е., если мне нужно, например, указать только ([Filename], [FileFormat](тут уже более-менее ясно) и [TextCodepage], как должно это писаться ?oBook:SaveAs(kyda+"\ttt.xls", xlExcel9795, ?, ?, ?, ?, ?, ?, ?, "1251"-?, ?, ?) А параметры "?", вообще, какие могут принимать значения ( и орфографически - где, например, про пропусках - "", 0, , и т.д., а где - указывать явно?) ?

Петр: Ну - это легко, выбираем метод SaveAs() нажимаем F1 (инсталяция MS Office должна быть полной конечно) и смотрим Saves changes to the workbook in a different file. expression.SaveAs(FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AccessMode, ConflictResolution, AddToMru, TextCodepage, TextVisualLayout, Local) expression Required. An expression that returns one of the above objects. Filename Optional Variant. A string that indicates the name of the file to be saved. You can include a full path; if you don't, Microsoft Excel saves the file in the current folder. FileFormat Optional Variant. The file format to use when you save the file. For a list of valid choices, see the FileFormat property. For an existing file, the default format is the last file format specified; for a new file, the default is the format of the version of Excel being used. Password Optional Variant. A case-sensitive string (no more than 15 characters) that indicates the protection password to be given to the file. WriteResPassword Optional Variant. A string that indicates the write-reservation password for this file. If a file is saved with the password and the password isn't supplied when the file is opened, the file is opened as read-only. ReadOnlyRecommended Optional Variant. True to display a message when the file is opened, recommending that the file be opened as read-only. CreateBackup Optional Variant. True to create a backup file. AccessMode Optional XlSaveAsAccessMode. XlSaveAsAccessMode can be one of these XlSaveAsAccessMode constants. xlExclusive (exclusive mode) xlNoChange default (don't change the access mode) xlShared (share list) If this argument is omitted, the access mode isn't changed. This argument is ignored if you save a shared list without changing the file name. To change the access mode, use the ExclusiveAccess method. ConflictResolution Optional XlSaveConflictResolution. XlSaveConflictResolution can be one of these XlSaveConflictResolution constants. xlUserResolution (display the conflict-resolution dialog box) xlLocalSessionChanges (automatically accept the local user's changes) xlOtherSessionChanges (accept other changes instead of the local user's changes) If this argument is omitted, the conflict-resolution dialog box is displayed. AddToMru Optional Variant. True to add this workbook to the list of recently used files. The default value is False. TextCodePage Optional Variant. Not used in U.S. English Microsoft Excel. TextVisualLayout Optional Variant. Not used in U.S. English Microsoft Excel. Local Optional Variant. True saves files against the language of Microsoft Excel (including control panel settings). False (default) saves files against the language of Visual Basic for Applications (VBA) (which is typically US English unless the VBA project where Workbooks.Open is run from is an old internationalized XL5/95 VBA project).

valery2: Петр пишет: Ну - это легко, выбираем метод SaveAs() нажимаем F1 (инсталяция MS Office должна быть полной конечно) и смотрим Спасибо! Но это не мой Office, и, видимо, не полный- Help-a точно нет.TextCodePage Optional Variant. Not used in U.S. English Microsoft Excel. Интересно- есть-ли оно в этом (вроде- русском) варианте... Извините, не очень понятен:TextVisualLayout Optional Variant. Not used in U.S. English Microsoft Excel. Счем его едят? Что оно делает?

valery2: Отпадает. Это я не опредыдущем сообщении, а то - что было здесь.

valery2:

SVN: А не проще ли просто в макросом Auto_open в Excel открыть данный Dbf-файл. И быстро и без волокиты.

Andrey: Всем привет. Опять вопрос по ЕКСЕЛЮ.... Открываю файл, записываю по ячейкам то что мне нужно, пытаюсь его сохранить (под тем же именем) и выйти - ОБЛОМ ! Вот код: oExcel:Visible := .F. oExcel:screenUpdating:=.T. oExcel:displayAlerts:=.T. oExcel:DisplayAlerts := .f. oExcel:save() oExcel:DisplayAlerts := .t. oExcel:Quit()

Dima: Andrey пишет: oExcel:DisplayAlerts := .t. нада oExcel:DisplayAlerts:=.f.

Dima: Andrey пишет: oExcel:Visible := .F. oExcel:screenUpdating:=.T. oExcel:displayAlerts:=.T. oExcel:DisplayAlerts := .f. oExcel:save() oExcel:DisplayAlerts := .t. // эту строку убери совсем oExcel:Quit() ЗЫ Тему перенес так как GUI тут не при делах

Andrey: Dima СПАСИБО БОЛЬШОЕ ! А как покрасить ячейку красным ? Или шрифт красным сделать ? oSheet:Cells( nI, 17 ):Font:Color:= clRed - не прокатывает, в файле #include "excel.ch" нет определения цветов. Поиск по форуму :Font:Color: выдает черт знает что....

Dima: Andrey пишет: А как покрасить ячейку красным ? Как обычно , включи запись макроса в Excel , покрась ячейку и глянь что записалось. Сколько строк у тебя в Excel.ch ? У меня 1543

Dima: Andrey пишет: Поиск по форуму :Font:Color: выдает черт знает что.... а если искать цвет ячейки excel (поиск по всем словам) то можно попасть вот сюда

Andrey: Dima пишет: Как обычно , включи запись макроса в Excel , покрась ячейку и глянь что записалось. У Дельфи есть пример: ASheet.Range['B3', EmptyParam].Characters[Length(Msg), 1].Font.Color := clBlue; Значит где-то описание всех цветов есть. Вот я и хочу цвета из него брать, а не каждый раз макрос делать.... Dima пишет: Сколько строк у тебя в Excel.ch ? У меня 1543 1723

Dima: Andrey пишет: clBlue значит надо найти (создать) CH файлик с описанием цветов например из Минигуи [pre2] //----------------------------------------------------------------------------// // Low Intensity colors //----------------------------------------------------------------------------// #define CLR_BLACK 0 // RGB( 0, 0, 0 ) #define CLR_BLUE 8388608 // RGB( 0, 0, 128 ) #define CLR_GREEN 32768 // RGB( 0, 128, 0 ) #define CLR_CYAN 8421376 // RGB( 0, 128, 128 ) #define CLR_RED 128 // RGB( 128, 0, 0 ) #define CLR_MAGENTA 8388736 // RGB( 128, 0, 128 ) #define CLR_BROWN 32896 // RGB( 128, 128, 0 ) #define CLR_HGRAY 12632256 // RGB( 192, 192, 192 ) #define CLR_LIGHTGRAY CLR_HGRAY //----------------------------------------------------------------------------// // High Intensity Colors //----------------------------------------------------------------------------// #define CLR_GRAY 8421504 // RGB( 128, 128, 128 ) #define CLR_HBLUE 16711680 // RGB( 0, 0, 255 ) #define CLR_HGREEN 65280 // RGB( 0, 255, 0 ) #define CLR_HCYAN 16776960 // RGB( 0, 255, 255 ) #define CLR_HRED 255 // RGB( 255, 0, 0 ) #define CLR_HMAGENTA 16711935 // RGB( 255, 0, 255 ) #define CLR_YELLOW 65535 // RGB( 255, 255, 0 ) #define CLR_WHITE 16777215 // RGB( 255, 255, 255 ) [/pre2]

Andrey: Dima пишет: а если искать цвет ячейки excel (поиск по всем словам) то можно попасть вот сюда Не догадался ... Dima пишет: значит надо найти (создать) CH файлик с описанием цветов Да хотелось бы.... Вот есть такие цвета: http://dmcritchie.mvps.org/excel/colors.htm

Dima: Andrey пишет: Да хотелось бы.... Так сделай или найди раз хотелка работает ;)

Dima: гугль рулит http://www.rapidtables.com/web/color/RGB_Color.htm

Andrey: Dima пишет: Так сделай или найди раз хотелка работает ;) Обязательно. Как только задачу закончу...

Andrey: Dima пишет: Так сделай или найди раз хотелка работает ;) Можно проще обходиться ! #include "tsbrowse.ch" oSheet:Cells( nI, 16 ):Interior:Color := RGB(255,255,255) // закраска ячейки белым oSheet:Cells( nI, 16 ):Interior:Color := CLR_HRED // закраска ячейки красным oSheet:Cells( nI, 16 ):Font:COLOR := CLR_HRED или RGB( 255, 0, 0 ) // цвет шрифта в ячейке Все уже готово и писать не надо !

Dima: Andrey пишет: Можно проще обходиться ! А ты не знал ? :)

Andrey: Dima пишет: А ты не знал ? :) Неа .... Меня в первом нашедшем примере смутило что числа задаются числом... А то что есть альтернатива, я как то не подумал...

Dima: Andrey Бывает



полная версия страницы