FoxPro Club Главная

Конференция Решения Фотоальбом Сайт М.Дроздова Статьи Файловый архив Книга Visual FoxPro 9.0 Русский Help для Visual FoxPro
Пользователей: 9233
Вход
Вывод данных GENERAL поля обратно в WORD

Если в GENERAL поле находится объект WORD - данные функции позволяют вывести содержимое поля обратно в ВОРД файл. Решение далеко не полностью мое, поэтому на авторство не претендую. Но все же у меня была такая задача - вдруг кому-нибудь пригодится...


 
Прислал: KID   Категория: Foxpro и другие приложения


Вывод данных GENERAL поля обратно в WORD


*************************************************
* Вывод результатов Дженерал поля в ВОРД - ResultToWord *
*************************************************
FUNCTION ResultToWord

cFileFolder = "c:\"

close all

* CopyGen Demo routine - you can modify this to suit your needs
*======================

********** Required code before CopyGen is called ********
SET LIBRARY TO &Main_path\foxtools.fll ADDITIVE &&
* &&
DIMENSION FnNum[7] &&
FnNum = -1 &&
**********************************************************


PrevSec = SECONDS()
use &Main_path\_tmp.DBF in 45 shared alias temporary &&c:\_tmp.dbf in 0 shared
SELECT temporary
goto top
cNameOfStudent = ALLTRIM(temporary.person)

sum temporary.bal TO nAllBalls

SELECT temporary
goto 2


scan all

* QUEST = General field name

RetVal = CopyGen(DBF("temporary"), recno(), "Quest", "c:\"+ALLTRIM(STR(RECNO())) ) && do not use targetfile extension

*****************************************
* формирование ВОРД-документов
* если в General поле стоит картинка - то попросту будет создан bmp, gif, jpeg файд
*****************************************

DO CASE
CASE RetVal = 0
* WAIT WINDOW "File extracted successfully! ("+STR(SECONDS()-PrevSec)+" seconds)";
* + CHR(13) + "Press any key to continue......"
CASE RetVal = -1
WAIT WINDOW "CopyGen demo works only with 1986 dbf file size!" + CHR(13) + "Press any key to continue......"
CASE RetVal = -2
WAIT WINDOW "File access error - not found or in exclusive use!" + CHR(13) + "Press any key to continue......"
CASE RetVal = -3
WAIT WINDOW "Incorrect filetype - not FPW/memo or VFP/memo!" + CHR(13) + "Press any key to continue......"
CASE RetVal = -4
WAIT WINDOW "Specified field not found in DBF file!"
CASE RetVal = -5
WAIT WINDOW "Specified field is not a general field!"
CASE RetVal = -6
* WAIT WINDOW "No valid .BMP or .DOC file found inside general field!"
ENDCASE

endscan

*************************
* создаем массив с созданными
* выще ВОРД-документами
*************************

n = adir(afiles, cFileFolder + "*.doc")

oWord = createobject("Word.application")
y = oWord.documents.ADD

**************
oRange = oWord.ActiveDocument.Range()

oword.Selection.Font.Size=12
oword.Selection.Font.bold=.t.
oword.Selection.ParagraphFormat.Alignment=1
oword.Selection.insertafter("Р Е З У Л Ь Т А Т И " + CHR(13) + CHR(13))

oword.Selection.insertafter(cNameOfStudent + CHR(13))

oword.Selection.insertafter("ДАТА : " + DTOC(DATE()) + " РОКУ, ЧАС: " + ;
TIME() + CHR(13))

oword.Selection.insertafter(CHR(13))

oword.Selection.InsertAfter('ЗАГАЛЬНА КIЛЬКIСТЬ : ' + str(nAllBalls))

END=oword.activedocument.Bookmarks("\ENDOFDOC").select
oword.Selection.ParagraphFormat.Alignment=0

With oRange
.moveend(6)
.collapse(0)
.insertafter(chr(13)+chr(13))
.collapse(0)
EndWith

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

oword.Selection.Font.Size=11
oword.Selection.Font.bold=.t.

oTable = oWord.ActiveDocument.Tables.Add(oRange,1,4)

WITH oTable

* First, put all borders
.Borders.InsideLineStyle = .t.
.Borders.OutsideLineStyle = .t.


* Put heading text in and set alignment

.Cell[1,1].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter
.Cell[1,2].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter
.Cell[1,3].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter
.Cell[1,4].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter

.cell[1,1].Range.InsertAfter('№')
.cell[1,1].Width = 30
.cell[1,2].Range.InsertAfter('Содержимое ВОРД файла')
.cell[1,2].Width = 320
.cell[1,3].Range.InsertAfter('Цифровое поле')
.cell[1,3].Width = 80
.cell[1,4].Range.InsertAfter('Еще одно цифровое поле')
.cell[1,4].Width = 40
ENDWITH
*oWord.visible = .t.

SELECT temporary
goto 2 &&top

nRowNum = 1

for i = 1 to n


z = oWord.documents.Open(cFileFolder + aFiles[i,1])
z.range.copyAsPicture
z.close
IF y.paragraphs.Count > 1
y.paragraphs.Add
ENDIF

oTable.Rows.Add()
oTable.Cell(nRowNum + 1,1).Range.InsertAfter(STR(nRowNum))
oTable.Cell(nRowNum + 1,2).Select

* вставка содержимого файла в один
oWord.Selection.paragraphs.Last.Range.Paste

SELECT temporary
goto i + 1

oTable.Cell(nRowNum + 1,3).Range.InsertAfter(STR(temporary.Answer,8,2))
oTable.Cell(nRowNum + 1,4).Range.InsertAfter(STR(temporary.bal))

nRowNum = nRowNum + 1

endfor
_cliptext = ""


oWord.visible = .t.
*wait window "wait..."
*oWord.quit


ERASE cFileFolder + "*.doc" && erase doc files
SELECT temporary
use in temporary

********************************************************
* END of Вывод результатов теста в ВОРД - ResultToWord *
********************************************************


**************************************************************
********* ****************
********* C O P Y C O N T E N T O F ****************
********* G E N E R A L F I E L D ****************
********* ****************
**************************************************************
procedure copygen
PARAMETER DBFFILE, RECNUM, FIELDNAME, OUTFILE
FIELDNAME = ALLTRIM(UPPER(FIELDNAME))
PRIVATE DBFHANDLE, MEMOHANDLE, OUTFHANDLE, MBLOCKSIZE, MEMOLEN
PRIVATE FIRSTRECPOS, RECORDLEN, MBLOCKSIZE, BLOCKPOS, DBFLEFT
PRIVATE FILETYPE, VFP_MEMO, GENFIELD
PRIVATE II, IICOUNT, IIREM, TEMPNO, FIELDFOUND
DBFHANDLE = LFOPEN(DBFFILE,64)
IF DBFHANDLE<0
RETURN -2
ENDIF
FILETYPE = GETVALUE(DBFHANDLE,0,1,1)
VFP_MEMO = FILETYPE=48 .AND. BIT(1,GETVALUE(DBFHANDLE,28,1,1))
IF FILETYPE<>245 .AND. .NOT. VFP_MEMO
= LFCLOSE(DBFHANDLE)
RETURN -3
ENDIF
PRIVATE DBFLEN
DBFLEN = LFSEEK(DBFHANDLE,0,2)
IF DBFLEN<>1986
* = LFCLOSE(DBFHANDLE)
* RETURN -1
ENDIF
FIRSTRECPOS = GETVALUE(DBFHANDLE,8,2,1)
RECORDLEN = GETVALUE(DBFHANDLE,10,2,1)
FIELDFOUND = .F.
GENFIELD = .F.
TEMPNO = 32
DO WHILE .NOT. FIELDFOUND .AND. TEMPNO TEMPS = GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))
IF UPPER(FIELDNAME)=GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))
FIELDFOUND = .T.
POSINREC = GETVALUE(DBFHANDLE,TEMPNO+12,4,1)
GENFIELD = 'G'=GETSTRING(DBFHANDLE,TEMPNO+11,1)
ELSE
TEMPNO = TEMPNO+32
ENDIF
ENDDO
IF .NOT. FIELDFOUND
= LFCLOSE(DBFHANDLE)
RETURN -4
ENDIF
IF .NOT. GENFIELD
= LFCLOSE(DBFHANDLE)
RETURN -5
ENDIF
IF VFP_MEMO
BLOCKPOS = GETVALUE(DBFHANDLE,FIRSTRECPOS+(RECNUM-1)*RECORDLEN+POSINREC,4,1)
ELSE
BLOCKPOS = VAL(GETSTRING(DBFHANDLE,FIRSTRECPOS+(RECNUM-1)*RECORDLEN+POSINREC,10))
ENDIF
= LFCLOSE(DBFHANDLE)
DBFLEFT = UPPER(IIF(RAT('.', DBFFILE)>0, LEFT(DBFFILE, RAT('.', DBFFILE)-1), DBFFILE))
MEMOHANDLE = LFOPEN(DBFLEFT+'.FPT',64)
MBLOCKSIZE = GETVALUE(MEMOHANDLE,6,2,-1)
MEMOLEN = GETVALUE(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS+4,4,-1)
TEMPS = GETSTRING(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS,128)
PRIVATE SIGNATURE, FILEEXT
DO CASE
CASE CHR(208)+CHR(207)+CHR(17)+CHR(224)$TEMPS
SIGNATURE = CHR(208)+CHR(207)+CHR(17)+CHR(224)
FILEEXT = '.DOC'
CASE 'BM'$TEMPS
SIGNATURE = 'BM'
FILEEXT = '.BMP'
OTHERWISE
= LFCLOSE(MEMOHANDLE)
RETURN -6
ENDCASE
= LFSEEK(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS-1+AT(SIGNATURE, TEMPS),0)
IICOUNT = INT(MEMOLEN/512)
IIREM = MOD(MEMOLEN, 512)
IF '.'$OUTFILE
OUTFILE = UPPER(IIF(RAT('.', OUTFILE)>0, LEFT(OUTFILE, RAT('.', OUTFILE)-1), OUTFILE))
ENDIF
OUTFHANDLE = LFCREATE(OUTFILE+FILEEXT)
FOR II = 1 TO IICOUNT
TEMPS = LFREAD(MEMOHANDLE,512)
= LFWRITE(OUTFHANDLE,TEMPS)
ENDFOR
IF IIREM>0
= LFWRITE(OUTFHANDLE,LFREAD(MEMOHANDLE,IIREM))
ENDIF
= LFCLOSE(MEMOHANDLE)
= LFCLOSE(OUTFHANDLE)
RETURN 0
ENDFUNC
*
FUNCTION GetValue
PARAMETER FILEHANDLE, FILELOC, NBYTES, DIRN
= LFSEEK(FILEHANDLE,FILELOC,0)
RETURN BYTE2INT(LFREAD(FILEHANDLE,NBYTES),DIRN)
ENDFUNC
*
FUNCTION byte2int
PARAMETER STRING, DIRN
PRIVATE STRLEN, A, B, RETVAL, I, J
RETVAL = 0
J = 0
A = IIF(DIRN>0, 0, LEN(STRING)-1)
B = IIF(DIRN>0, LEN(STRING)-1, 0)
FOR I = A TO B STEP DIRN
J = J+1
RETVAL = ASC(SUBSTR(STRING, J, 1))*256**I+RETVAL
ENDFOR
RETURN RETVAL
ENDFUNC
*
FUNCTION GetString
PARAMETER FILEHANDLE, FILELOC, NBYTES
= LFSEEK(FILEHANDLE,FILELOC,0)
RETURN LFREAD(FILEHANDLE,NBYTES)
ENDFUNC
*
FUNCTION Bit
PARAMETER BITNO, A
RETURN INT(MOD(A/2**BITNO, 2))=1
ENDFUNC
*
FUNCTION LFCREATE
PARAMETER FNAME, FATTRIB
PRIVATE FILEHANDLE
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(1)
FILEHANDLE = CALLFN(FNNUM(1),FNAME,IIF(PARMS>2, FATTRIB, 0))
IF FILEHANDLE>-1
FNNUM[7] = LFSEEK(FILEHANDLE,0,2)
= LFSEEK(FILEHANDLE,0,0)
ENDIF
RETURN FILEHANDLE
ENDFUNC
*
FUNCTION LFOPEN
PARAMETER FNAME, FATTRIB
PRIVATE FILEHANDLE
FILEHANDLE = -1
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(2)
FILEHANDLE = CALLFN(FNNUM(2),FNAME,IIF(PARMS=1, 0, FATTRIB))
IF FILEHANDLE>-1
FNNUM[7] = LFSEEK(FILEHANDLE,0,2)
= LFSEEK(FILEHANDLE,0,0)
ENDIF
RETURN FILEHANDLE
ENDFUNC
*
FUNCTION LFCLOSE
PARAMETER FILEHANDLE
= REGFUNCTS(3)
RETURN CALLFN(FNNUM(3),FILEHANDLE)
ENDFUNC
*
FUNCTION LFREAD
PARAMETER FILEHANDLE, BYTESTOREAD
PRIVATE READBUF, BYTESREAD
BYTESTOREAD = INT(BYTESTOREAD)
READBUF = REPLICATE(CHR(0), BYTESTOREAD)
= REGFUNCTS(4)
BYTESREAD = CALLFN(FNNUM(4),FILEHANDLE,@READBUF,BYTESTOREAD)
RETURN READBUF
ENDFUNC
*
FUNCTION LFWRITE
PARAMETER FILEHANDLE, WSTRING, BYTESTOWRITE
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(5)
RETURN CALLFN(FNNUM(5),FILEHANDLE,WSTRING,IIF(PARMS<3, LEN(WSTRING), BYTESTOWRITE))
ENDFUNC
*
FUNCTION LFSEEK
PARAMETER FILEHANDLE, FOFFSET, RELTO
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(6)
RETURN CALLFN(FNNUM(6),FILEHANDLE,INT(FOFFSET),IIF(PARMS=3, RELTO, 0))
ENDFUNC
*
FUNCTION LFEOF
PARAMETER FILEHANDLE
= REGFUNCTS(6) && = REGFUNTCS(6)
RETURN CALLFN(FNNUM(6),FILEHANDLE,0,1)>=FNNUM(7)
ENDFUNC
*
PROCEDURE RegFuncts
PARAMETER FNID
IF FNNUM(FNID)>-1
RETURN
ENDIF
DO CASE
CASE FNID=1
FNNUM[1] = REGFN("_lcreat","CI","I")
CASE FNID=2
FNNUM[2] = REGFN("_lopen","CI","I")
CASE FNID=3
FNNUM[3] = REGFN("_lclose","I","I")
CASE FNID=4
FNNUM[4] = REGFN("_lread","I@CI","I")
CASE FNID=5
FNNUM[5] = REGFN("_lwrite","ICI","I")
CASE FNID=6
FNNUM[6] = REGFN("_llseek","ILI","L")
ENDCASE
ENDPROC
*
***********************


 
Сделайте оценку этого решения Плохо Удовлетворительно Так себе Хорошо Отлично Текущая оценка: (4.727)
Дополнения пользователей
Вывод данных GENERAL поля обратно в WORD
[+][?]
dimuhametov
13.02.09 17:09:48

Строку:
DO WHILE .NOT. FIELDFOUND .AND. TEMPNO TEMPS = GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))
заменить на:
DO WHILE .NOT. FIELDFOUND 
TEMPS = GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))
тогда все работает.
Андрей П.
15.12.15 15:11:43

А у меня чего-то не взлетает. Можно поподробнее как запустить функцию, очень надо.
[Дополнить]



© 2000-2017 Fox Club 
При размещении любых материалов с сайта на других ресурсах- прямая ссылка на www.foxclub.ru обязательна
Яндекс.Метрика