Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Vfp и EXCEL

342 views
Skip to first unread message

Дарья Дмитриевна Дашкова

unread,
Aug 3, 2002, 2:59:02 AM8/3/02
to
Здравствуйте!
Мне необходим совет.
Как сделать видимым в EXCEL-е файл xls-ский,
в который добовляется ДБ из таблицы dbf?
Я так поняла, что нужно свойство окна xls-ого
файла Visible установить в .t.,но у меня не получается,
фокс выдает ошибку.
А в Word-е содержимое xls-файла можно увидеть!

И еще вопрос, почему фокс выдает ошибку при компиляции
"Интерфейс не поддерживается", когда я пишу команду:
OleObjekt=Getobject('','excel.application')

--
Отправлено через сервер Форумы@mail.ru - http://talk.mail.ru

Константин Васин

unread,
Aug 3, 2002, 4:25:55 PM8/3/02
to
Доброго времени суток, Дарья Дмитриевна Дашкова!

ДДД> Здравствуйте! Мне необходим совет. Как сделать видимым в EXCEL-е
ДДД> файл xls-ский, в который добовляется ДБ из таблицы dbf? Я так
ДДД> поняла, что нужно свойство окна xls-ого файла Visible установить
ДДД> в .t.,но у меня не получается, фокс выдает ошибку. А в Word-е
ДДД> содержимое xls-файла можно увидеть!

ДДД> И еще вопрос, почему фокс выдает ошибку при компиляции
ДДД> "Интерфейс не поддерживается", когда я пишу команду:
ДДД> OleObjekt=Getobject('','excel.application')

А вот хорошо бы кто-нибудь объяснил поподробнее, как вообще сделать
передачу отчёта в Exсel. Вот есть отфильтрованная база.
Что и как делать дальше? Нужен отчёт с шапкой и подписями.

--
Константин
ring...@mailru.com
P.S. Спеша, давясь любимым человеком (В. Вишневский)

Michael Drozdov

unread,
Aug 4, 2002, 4:44:18 AM8/4/02
to
Привет, Константин.

Sun Aug 04 2002 00:25, Константин Васин wrote to Дарья Дмитриевна Дашкова:

КВ> А вот хорошо бы кто-нибудь объяснил поподробнее, как вообще сделать
КВ> передачу отчёта в Exсel. Вот есть отфильтрованная база.
КВ> Что и как делать дальше? Hужен отчёт с шапкой и подписями.

Надо бы сходить на курсы по VBA :-)
...вот так можно сделать первый шаг:

*/////////////
#DEFINE xlNone -4142 &&(&HFFFFEFD2)
#DEFINE xlDiagonalDown 5
#DEFINE xlDiagonalUp 6
#DEFINE xlEdgeLeft 7
#DEFINE xlEdgeTop 8
#DEFINE xlContinuous 1
#DEFINE xlThin 2
#DEFINE xlThick 4
#DEFINE xlAutomatic -4105 &&(&HFFFFEFF7)
#DEFINE xlEdgeBottom 9
#DEFINE xlDouble -4119 &&(&HFFFFEFE9)
#DEFINE xlEdgeRight 10

PUBLIC ox
ox=CreateObject("Excel.application")
ox.visible=.t.
ox.windowstate=1
ox.left = 10
ox.application.top = 10
ox.workbooks.add
FOR j= 1 to 5
FOR i = 1 TO 3
ox.cells[i,j].value = I * 10 + j
ENDFOR
WITH ox.cells[4,j]
.Select
.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
WITH .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
ENDWITH
WITH .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
ENDWITH
.Borders(xlEdgeRight).LineStyle = xlNone
ENDWITH
ENDFOR
*/////////////

... а дальше хм... ну можно посмотреть на
http://vfpdmur.narod.ru/docs/vfpexcel.html <- Формирование отчетов из VFP в
Excel - Шпаргалка от Валентина Ярычевского

Best regards.
Михаил Дроздов, ИВС Софт, Пермь, Россия
[Michael Drozdov, ICS Soft, Perm, Russia]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Mailto:Dro...@ics.perm.su
My Page: http://vfpdmur.narod.ru/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sun Aug 04 2002 00:25, Константин Васин wrote to Дарья Дмитриевна Дашкова:

КВ> From: Константин Васин <ring...@mailru.com>

КВ> Доброго времени суток, Дарья Дмитриевна Дашкова!

ДДД>> Здравствуйте! Мне необходим совет. Как сделать видимым в EXCEL-е
ДДД>> файл xls-ский, в который добовляется ДБ из таблицы dbf? Я так
ДДД>> поняла, что нужно свойство окна xls-ого файла Visible установить
ДДД>> в .t.,но у меня не получается, фокс выдает ошибку. А в Word-е
ДДД>> содержимое xls-файла можно увидеть!

ДДД>> И еще вопрос, почему фокс выдает ошибку при компиляции
ДДД>> "Интерфейс не поддерживается", когда я пишу команду:
ДДД>> OleObjekt=Getobject('','excel.application')

КВ> А вот хорошо бы кто-нибудь объяснил поподробнее, как вообще сделать
КВ> передачу отчёта в Exсel. Вот есть отфильтрованная база.
КВ> Что и как делать дальше? Hужен отчёт с шапкой и подписями.

КВ> --
КВ> Константин
КВ> ring...@mailru.com
КВ> P.S. Спеша, давясь любимым человеком (В. Вишневский)

КВ> Отправлено через сервер Форумы@mail.ru - http://talk.mail.ru

Наилучшие пожелания

Александр Головлев

unread,
Aug 5, 2002, 3:46:08 AM8/5/02
to
Привет!

Если интересует как передать данные в Excel, то
для этого есть масса вариантов. Самый очевидный -
COPY TO ... TYPE XL5
Можно также заполнять все ячейки в цикле
посредством OLE автоматизации. Но это слишком
утомительно для программиста и слишком медленно
по скорости исполнения.
Можно передавать данные через клиборд, используя
метод _VFP.DataToClip для копирования записей.
Однако у меня при этом искажалась вся кириллица.
Наконец, можно загнать данные в ADO рекордсет,
используя один из методов CursorToRs, Dbf2Rs и т.д.,
а затем вставить данные из рекордсета посредством
экселовского метода CopyFromRecordset. Этот способ
работает только с Excel 2000 и выше. Пример использования
этого метода можно найти в OLEDB library в разделе
downloads на UniversalThread (file #10002). Программа
Dbc2Xls.prg перегоняет все таблицы из текущей базы
данных на отдельные листы в Экселе. В том же файле
есть процедура Dbf2Xls.
Ниже приводится процедура QuickReport, использующая для
передачи в Excel COPY TO, которую Даниэль Грамунт
опубликовал на UniversalThread в сообщении #597306.

HTH, WBR и т.д. и т.п.

************************************************
PROCEDURE QuickReport
************************************************
*) Description.......: Formats and sends the content of the currently
selected
*) : table/cursor to Excel using automation.
*) :
*) : The following modes are suppored:
*) :
*) : 1 = ToExcelNoShow
*) : 2 = ToExcelPreview
*) : 3 = ToPrinterNoShow (Excel file deleted)
*) :
*) : Returns: Numeric
*) : 0 if successful
*) :
*) : If Error occurred:
*) : -1 Parameter < tnMode > missing or invalid
value
*) : -2 Parameter < tcOutputFile > missing or
wrong type
*) : -3 No table open in current work area
*) :
* Calling Samples...: o.QuickReport(1, "c:\temp\customers.xls") &&
ToExcelNoShow
* : o.QuickReport(2) &&
ToExcelPreview
* : o.QuickReport(3) &&
ToPrinterNoShow
* Parameter List....: tnMode - See above
* : tcOutputFile - Excel output file. Required for mode <
cnToExcelNoShow >
* Major change list.:
*---------------------------------------------------------------------------
-----------------------
LPARAMETERS tnMode, tcOutputFile

*-- possible values for < tnMode >
#DEFINE cnToExcelNoShow 1
#DEFINE cnToExcelPreview 2
#DEFINE cnToPrinterNoShow 3

#DEFINE clSuppressMessages .f.
#DEFINE ccCrLf CHR(13)+CHR(10)

#DEFINE MB_ICONEXCLAMATION 48 && Warning message
#DEFINE MB_YESNO 4 && Yes and No buttons
#DEFINE MB_ICONQUESTION 32 && Warning query
#DEFINE IDYES 6 && Yes button pressed

#DEFINE xlLeft 1
#DEFINE xlCenter -4108
#DEFINE xlRight -4152
#DEFINE xlLandscape 2
#DEFINE xlWorkbookNormal -4143 && used by SaveAs()
to save in current version
#DEFINE cnInchesToPoints 72
#DEFINE cnCentimetersToPoints cnInchesToPoints / 2.54

#DEFINE icMessageBoxCaption "QuickReport - 1.02"
*-- adjust the following line!
#DEFINE ccAviFile "C:\Program Files\Microsoft Visual
Studio\Common\Graphics\Videos\FileMove.avi"

*-- check
parameters -----------------------------------------------------------------
-------------
IF TYPE("tnMode") <> "N" OR NOT BETWEEN(tnMode, 1, 3)
MessageBox("QuickReport() - Parameter < tnMode > missing or wrong vale."
+ ccCrLf +;
"Use one of the following:" + ccCrLf +;
"1 = ToExcelNoShow" + ccCrLf +;
"2 = ToExcelPreview" + ccCrLf +;
"3 = ToPrinterNoShow",;
MB_ICONEXCLAMATION,;
icMessageBoxCaption)
RETURN -1
ENDIF

IF tnMode = cnToExcelNoShow
*-- tcOutputFile must be passed
IF TYPE("tcOutputFile") <> "C" OR EMPTY(tcOutputFile)
MessageBox("QuickReport() - Parameter < tcOutputFile > missing or
wrong type.",;
MB_ICONEXCLAMATION,;
icMessageBoxCaption)
RETURN -2
ENDIF
ENDIF

LOCAL lcExcelFile, lcMessageCaption, lcAviFile, lcAlias, lcDbc
LOCAL llFreeTable, loMessage, lnFields, i, lcFieldName, lcFieldCaption
LOCAL lcSafe, oXLS, lcTableName, lnRetVal, lnVfpHandle

lcAlias = ALIAS()
lcDbc = DBC()

IF EMPTY(lcAlias)
MessageBox("QuickReport() - No table open in current work area.",;
MB_ICONEXCLAMATION,;
icMessageBoxCaption)
RETURN -3
ENDIF

DO CASE
CASE tnMode = cnToExcelNoShow
lcExcelFile = FORCEEXT(tcOutputFile, "XLS")
lcMessageCaption = "Sending data to Excel..."
*lcAviFile = "CopyToExcel.avi"
CASE tnMode = cnToExcelPreview
lcExcelFile = ADDBS(SYS(2023))+RIGHT(SYS(3),8)+".XLS"
lcMessageCaption = "Sending data to Excel..."
*lcAviFile = "CopyToExcel.avi"
CASE tnMode = cnToPrinterNoShow
lcExcelFile = ADDBS(SYS(2023))+RIGHT(SYS(3),8)+".XLS"
lcMessageCaption = "Sending data to printer..."
*lcAviFile = "CopyToPrinter.avi"
ENDCASE

llFreeTable = EMPTY(CURSORGETPROP("DATABASE"))

IF NOT llFreeTable
SET DATABASE TO (CURSORGETPROP("DATABASE"))
ENDIF

*-- display message
IF NOT clSuppressMessages
loMessage = NEWOBJECT("Animation", "Animation.prg", "",;
lcMessageCaption,;
icMessageBoxCaption,;
ccAviFile)
ENDIF

lnFields = FCOUNT()
DIMENSION laFields[lnFields, 1]

FOR i = 1 TO lnFields

lcFieldName = FIELD(i)
lcFieldCaption = ""

IF NOT llFreeTable
*-- get field caption from DBC
lcFieldCaption = DBGetProp(lcAlias+"."+lcFieldName, "Field",
"Caption")
ENDIF

laFields[i, 1] = IIF(EMPTY(lcFieldCaption), lcFieldName, lcFieldCaption)

ENDFOR &&* i = 1 TO lnFields

*-- export selected fields to Excel
lcSafe = SET("SAFETY")
SET SAFETY OFF

COPY TO (lcExcelFile) TYPE XL5

SET SAFETY &lcSafe

*---------------------------------------------------------------------------
-----------------------
*-- open Excel file and format worksheet
*---------------------------------------------------------------------------
-----------------------

oXLS = CREATEOBJECT("Excel.Application")
oXLS.Application.Workbooks.Open(lcExcelFile)
oXls.Application.DisplayAlerts = .f.

*-- get tablename
lcTableName = DBF()

*-- use name of alias if we're dealing with a cursor
IF ".TMP" $ UPPER(lcTableName)
lcTableName = "Cursor - " + ALIAS()
ENDIF

*-- set pageSetup properties
WITH oXLS.Application.ActiveSheet.PageSetup
*.LeftHeader = ""
.CenterHeader = lcTableName
*.RightHeader = ""
.LeftFooter = icMessageBoxCaption
.CenterFooter = "&P of &N"
.RightFooter = "&D - &T"
.LeftMargin = cnCentimetersToPoints * 1.9
.RightMargin = cnInchesToPoints * 0.27244094488189
.TopMargin = cnInchesToPoints * 0.47244094488189
.BottomMargin = cnInchesToPoints * 0.47244094488189
.HeaderMargin = cnInchesToPoints * 0.236220472440945
.FooterMargin = cnInchesToPoints * 0.236220472440945
*.PrintHeadings = .f.
*.PrintGridlines = .f.
*.PrintComments = xlPrintNoComments
*.PrintQuality = 600
*.CenterHorizontally = .t.
*.CenterVertically = .t.
.Orientation = xlLandscape
*.Draft = .f.
*.PaperSize = xlPaperA4
*.FirstPageNumber = xlAutomatic
*.Order = xlDownThenOver
*.BlackAndWhite = .f.
.Zoom = .f.
.FitToPagesWide = 1
.FitToPagesTall = .f.
.PrintTitleRows = "$1:$1" && repeats header on each page
ENDWITH

*-- format column headings

*-- change column captions
FOR i = 1 TO lnFields
oXLS.Worksheets(1).Range(oXLS.Worksheets(1).Cells(1, i),
oXLS.Worksheets(1).Cells(1, i)).Select
oXLS.Selection.value = laFields[i, 1]
ENDFOR

*-- select first row
oXLS.Worksheets(1).Range(oXLS.Worksheets(1).Cells(1, 1),
oXLS.Worksheets(1).Cells(1, lnFields)).Select

oXLS.Selection.AutoFormat(1)

*-- format header row
With oXLS.Selection.Font
*.Name = "Arial"
*.Size = 12
.Bold = .t.
.Italic = .f.
.Shadow = .f.
EndWith

WITH oXLS

*-- set width of each column to fit content
.Columns().EntireColumn.AutoFit

.Selection.Interior.ColorIndex = 15 && grey background
.Selection.HorizontalAlignment = xlLeft

ENDWITH

lnRetVal = 0

DECLARE Sleep IN WIN32API INTEGER nMillisecs

*-- perform output/save actions based on < tnMode >
DO CASE
CASE tnMode = cnToExcelNoShow
*-- save formatted Excel file
oXls.ActiveSheet.saveAs(lcExcelFile, xlWorkbookNormal)
oXls.Application.Quit
lnRetVal = IIF(FILE(lcExcelFile), 0, -35)
CASE tnMode = cnToExcelPreview
*-- preview
oXls.visible=.t.
oXls.Application.DisplayAlerts = .t.
oXls.ActiveWindow.SelectedSheets.PrintPreview
*-- we don't close Excel after the user closes the
*-- preview window. Note that we haven't yet saved the
*-- Excel file. This allows the user to either discard
*-- the file or save it manually.

DECLARE INTEGER FindWindow IN Win32api STRING, STRING
DECLARE SetForegroundWindow IN Win32api INTEGER

lnVfpHandle = FindWindow(.NULL., _screen.caption)

*-- bring VFP to the foreground before displaying the messagebox
IF lnVfpHandle <> 0
SetForegroundWindow(lnVfpHandle)
ENDIF

IF MESSAGEBOX("Do you want to save the Excel file?",
MB_YESNO+MB_ICONQUESTION, icMessageBoxCaption) = IDYES
*-- nothing to do, keep Excel open and bring Excel to the
foreground
lnXlsHandle = FindWindow(.NULL., oXls.caption)

IF lnXlsHandle <> 0
SetForegroundWindow(lnXlsHandle)
ENDIF

ELSE
*-- user doesn't want to save the Excel file,
*-- so we quit Excel without saving and delete the file
oXls.DisplayAlerts = .f.
oXLS.Application.Quit
RELEASE oXLS

Sleep(500)

IF FILE(lcExcelFile)
DELETE FILE (lcExcelFile)
ENDIF

ENDIF

CASE tnMode = cnToPrinterNoShow
oXls.ActiveWindow.SelectedSheets.PrintOut()
*-- quit Excel without saving and delete the file
oXls.DisplayAlerts = .f.
oXLS.Application.Quit
RELEASE oXLS

sleep(500)

IF FILE(lcExcelFile)
DELETE FILE (lcExcelFile)
ENDIF
ENDCASE

*-- remove message
IF TYPE("loMessage") = "O" AND NOT ISNULL(loMessage)
RELEASE loMessage
ENDIF

IF NOT EMPTY(lcDbc)
SET DATABASE TO (lcDbc)
ELSE
SET DATABASE TO
ENDIF

RETURN lnRetVal
*-- EOF Method
QuickReport ----------------------------------------------------------------
---------------

************************************************
*-- Class: Animation
************************************************
* Author............: Daniel Gramunt
* Created...........: 17.05.99 17:03:36
*) Description.......: Displays an animation (AVI) using the animation
control that
*) : ships with VFP.
*) : Handy for processes for which you cannot use a
thermometer.
* Calling Samples...: oAnimation = NEWOBJECT("Animation", "avi.prg", "",;
* : "Creating PDF file",;
* : "PDF converter",;
* : "FileToPdf.avi")
* Parameter List....:
* Major change list.:
*---------------------------------------------------------------------------
-----------------------
DEFINE CLASS Animation AS form

DataSession = 1
Height = 85
Width = 360
AutoCenter = .T.
Caption = ""
ControlBox = .F.
Closable = .F.
ClipControls = .F.
Name = "frmAnimation"

ADD OBJECT lblMessage AS label WITH ;
WordWrap = .T., ;
Caption = "Your message goes here...", ;
Left = 6, ;
Top = 2, ;
Width = 355, ;
Name = "lblMessage"

PROCEDURE Load
This.AddObject("oleAnimation", "oleControl", "MsComCtl2.Animation.2")
WITH This.oleAnimation
.Top = 28
.Left = 46
.Visible = .f.
ENDWITH
ENDPROC

PROCEDURE Init
* Parameter List....: tcMessage - Message to display. Optional.
* : tcCaption - Form caption. Optional.
* : If omitted, the form doesn't have a
title bar
* : tcAviFile - Animation file to display (default =
fileCopy.avi)
* Major change list.:

*---------------------------------------------------------------------------
-----------------------
LPARAMETER tcMessage, tcCaption, tcAviFile

WITH This

*-- check
parameters -----------------------------------------------------------------
-------------
IF TYPE("tcMessage") <> "C" OR EMPTY(tcMessage)
tcMessage = "Processing. Please be patient..."
ENDIF
IF TYPE("tcCaption") <> "C" OR EMPTY(tcCaption)
*-- no caption, so we remove the title bar
.TitleBar = 0
ELSE
.TitleBar = 1
.caption = tcCaption
ENDIF
IF TYPE("tcAviFile") <> "C"
tcAviFile = "fileCopy.avi"
ENDIF
.lblMessage.caption = tcMessage
.aviPlay(tcAviFile)
.show()
ENDWITH
ENDPROC

PROCEDURE AviPlay
LPARAMETERS tcAviFile

*-- make sure file exists
IF FILE(tcAviFile)
*-- update animation
WITH ThisForm.oleAnimation
.visible = .f.
.stop
.open(FULLPATH(tcAviFile))
.play()
.Height = 60
.Width = 275
.visible = .t.
ENDWITH
ENDIF
ENDPROC

ENDDEFINE

0 new messages