This project is read-only.

FoxCharts & Word

Feb 23, 2009 at 10:54 AM

Hi, Cesar!
Can you add new button 'Send to MS Word'?
Click commands:

 

LOCAL

 

 

lcDir, lcWordname, lnChart, loChart AS FoxCharts OF "..\Source\FoxCharts.Vcx"

 

loChart =

 

THISFORM.FoxCharts1

 

lcDir =

 

ADDBS(GETENV("TEMP"))

 

lcWordname = lcDir + 'Charts.html'

 

 

LOCAL

 

 

laHeaders(THISFORM.FoxCharts1.ChartsCount+1,2)

 

laHeaders(1,1)='Legend'

laHeaders(1,2)=''

 

 

FOR

 

 

lnChart=1 TO THISFORM.FoxCharts1.ChartsCount

 

laHeaders(lnChart+1,1)='Chart'+

 

ALLTRIM(STR(lnChart))

 

laHeaders(lnChart+1,2)=

 

EVL(THISFORM.FoxCharts1.FIELDS(lnChart).Legend,'-')

 

NEXT

THISFORM

 

 

.FoxCharts1.oBmp.ToClipboard()

=Chart2Word(lcWordname,THISFORM.FoxCharts1.SourceAlias,@laHeaders,THISFORM.FoxCharts1.TITLE.CAPTION,THISFORM.FoxCharts1.SubTITLE.CAPTION)

 

Chart2Word.prg

LPARAMETERS

 

 

lcDocumentName, lcCursor, laHeaders,laHeader1, lcTitle1, lcTitle2, lnTableNum

 

LOCAL

 

 

lc, ;

 

lnColumns, lnEnd, lnLine, lnRows, lnStart, lnStartRows, ;

loTable, loWord, luValue

LOCAL

 

 

loWord

 

loWord = OpenWord(lcDocumentName)

lnRows=1

lnColumns=

 

ALEN(laHeaders,1)

 

WITH

 

 

loWord

 

.

 

SELECTION.WholeStory

 

 

 

IF NOT EMPTY(lcTitle1)

 

.

 

SELECTION.TypeText (lcTitle1)

 

.

 

SELECTION.ParagraphFormat.ALIGNMENT = 1

 

.

 

SELECTION.TypeParagraph

 

 

 

ENDIF

 

IF

 

 

NOT EMPTY(lcTitle2)

 

.

 

SELECTION.TypeText (lcTitle2)

 

.

 

SELECTION.ParagraphFormat.ALIGNMENT = 1

 

.

 

SELECTION.TypeParagraph

 

 

 

ENDIF

 

 

 

 

.SELECTION.paste()

 

.ActiveDocument.

 

TABLES.ADD(.SELECTION.RANGE(), lnRows, lnColumns, .T., .F.)

 

 

lnTableNum=

 

EVL(lnTableNum,1)

 

 

 

SELECT (lcCursor)

 

loTable=loWord.ActiveDocument.

 

TABLES(lnTableNum)

 

loTable.

 

SELECT

 

 

 

 

lnStartRows=1 &&loTable.ROWS.COUNT

 

 

 

 

lc=''

 

 

 

FOR lnLine=1 TO lnColumns

 

lc=lc+

 

ALLTRIM(laHeaders(lnLine,2))+CHR(13)

 

 

 

NEXT

 

SELECT

 

 

(lcCursor)

 

lnRows=0

 

 

SCAN

 

 

 

 

lnRows = lnRows + 1

 

 

 

FOR lnLine=1 TO lnColumns

 

luValue=

 

NVL(EVALUATE(laHeaders(lnLine,1)),'')

 

lc = lc+

 

IIF(VARTYPE(luValue)='C',ALLTRIM(luValue),ALLTRIM(STR(luValue)))+CHR(13)

 

 

 

NEXT

 

ENDSCAN

IF

 

 

lnRows>1

 

loWord.

 

SELECTION.MoveDown (5, 1)

 

loWord.

 

SELECTION.InsertRows(lnRows-1)

 

 

 

ENDIF

 

_CLIPTEXT

 

 

= lc

 

lnStart=loTable.Cell(lnStartRows,1).

 

RANGE.START

 

lnEnd=loTable.Cell(lnStartRows+lnRows-1,lnColumns).

 

RANGE.END

 

loWord.ActiveDocument.

 

RANGE(lnStart,lnEnd).paste()

 

.

 

SELECTION.TypeParagraph

 

loTable.Cell(1,1).

 

RANGE.TEXT=''

 

ENDWITH

OpenWord.prg

 

 

LPARAMETERS lcDoc, llInVisible

 

 

 

DECLARE INTEGER SetForegroundWindow IN Win32API LONG HWND

 

DECLARE LONG

 

 

FindWindow IN Win32API STRING lpClassName,STRING lpWindowName

 

 

 

TRY

 

 

 

 

loWord=GETOBJECT(,"WORD.APPLICATION")

 

 

 

CATCH TO loErr WHEN loErr.ERRORNO=1426

 

loWord=

 

CREATEOBJECT("WORD.APPLICATION")

 

 

 

FINALLY

 

ENDTRY

PUBLIC

 

 

lo

 

 

 

IF TYPE('loWord.ActiveDocument')='O'

 

loWord.ActiveDocument.

 

CLOSE

 

ENDIF

 

 

 

lnWindow = FindWindow(.NULL., loWord.NAME)

 

 

 

IF !EMPTY(lcDoc)

 

lcDoc=

 

LOWER(FORCEEXT(ALLTRIM(lcDoc),'doc'))

 

 

 

IF FILE(lcDoc)

 

lcDoc=

 

FULLPATH(lcDoc)

 

loWord.Documents.

 

OPEN(lcDoc)

 

 

 

ELSE

 

 

 

 

loWord.Documents.ADD ("Normal", .F., 0)

 

lcPath=

 

JUSTPATH(lcDoc)

 

 

 

IF NOT DIRECTORY(lcPath)

 

 

 

MD (lcPath)

 

 

 

ENDIF

 

 

 

 

loWord.ActiveDocument.SAVEAS(lcDoc)

 

 

 

ENDIF

 

ENDIF

 

 

 

loWord.VISIBLE=! llInVisible

 

 

 

IF lnWindow # 0

 

SetForegroundWindow(lnWindow)

 

 

ENDIF

 

RETURN

 

 

loWord

 

I hope you can make it better according your last version.
I enjoy you last version new features.
Regards!
Feb 23, 2009 at 12:17 PM
Hi Yudin !

Thanks for this new sample !
I hope you saw your HTML output sample in the latest releases - Thanks !

Could you please repost this sample, but using plain text ?
The CodePlex site truncates all the VFP codes pasted directly.

Paste first your code to a NotePad Window, and from there you paste here as preformatted text, using the "PRE" and "/PRE" tags, editing directly the HTML.
See that we have a button "<>" above the "post reply" button.
LOCAL lcDir, lcWordname, lnChart, loChart AS FoxCharts OF "..\Source\FoxCharts.Vcx" 
loChart = THISFORM.FoxCharts1 
lcDir = ADDBS(GETENV("TEMP")) 
lcWordname = lcDir + 'Charts.html'
LOCAL laHeaders(THISFORM.FoxCharts1.ChartsCount+1,2) 
THANKS IN ADVANCE !
Feb 23, 2009 at 3:05 PM

Let's add new button 'Send to MS Word'?
NewButton.Click commands:

LOCAL lcDir, lcWordname, lnChart, loChart AS FoxCharts OF "..\Source\FoxCharts.Vcx"
loChart = THISFORM.FoxCharts1

lcDir = ADDBS(GETENV("TEMP"))
lcWordname = lcDir + 'Charts.html'
LOCAL laHeaders(THISFORM.FoxCharts1.ChartsCount+1,2)
laHeaders(1,1)='Legend'

laHeaders(1,2)=''

FOR lnChart=1 TO THISFORM.FoxCharts1.ChartsCount
laHeaders(lnChart+1,1)='Chart'+ALLTRIM(STR(lnChart))
laHeaders(lnChart+1,2)=
EVL(THISFORM.FoxCharts1.FIELDS(lnChart).Legend,'-')
NEXT
THISFORM
.FoxCharts1.oBmp.ToClipboard()
=Chart2Word(lcWordname,THISFORM.FoxCharts1.SourceAlias,@laHeaders,THISFORM.FoxCharts1.TITLE.CAPTION,THISFORM.FoxCharts1.SubTITLE.CAPTION)

 

Chart2Word.prg
LPARAMETERS lcDocumentName, lcCursor, laHeaders,laHeader1, lcTitle1, lcTitle2, lnTableNum
LOCAL lc, lnColumns, lnEnd, lnLine, lnRows, lnStart, lnStartRows, ;
loTable, loWord, luValue

loWord = OpenWord(lcDocumentName)
lnRows=1
lnColumns=ALEN(laHeaders,1)
WITH loWord
.SELECTION.WholeStory
IF NOT EMPTY(lcTitle1)
.SELECTION.TypeText (lcTitle1)
.SELECTION.ParagraphFormat.ALIGNMENT = 1
.SELECTION.TypeParagraph
ENDIF
IF NOT EMPTY(lcTitle2)
.SELECTION.TypeText (lcTitle2)
.SELECTION.ParagraphFormat.ALIGNMENT = 1
.SELECTION.TypeParagraph
ENDIF
.SELECTION.paste()
.ActiveDocument.TABLES.ADD(.SELECTION.RANGE(), lnRows, lnColumns, .T., .F.)
lnTableNum=EVL(lnTableNum,1)
SELECT (lcCursor)
loTable=loWord.ActiveDocument.TABLES(lnTableNum)
loTable.SELECT
lnStartRows=1 &&loTable.ROWS.COUNT fo multiple use
lc=''
FOR lnLine=1 TO lnColumns
lc=lc+ALLTRIM(laHeaders(lnLine,2))+CHR(13)
NEXT
SELECT (lcCursor)
lnRows=0
SCAN
lnRows = lnRows + 1
FOR lnLine=1 TO lnColumns
luValue=NVL(EVALUATE(laHeaders(lnLine,1)),'')
lc = lc+IIF(VARTYPE(luValue)='C',ALLTRIM(luValue),ALLTRIM(STR(luValue)))+CHR(13)
NEXT
ENDSCAN
IF lnRows>1
loWord.SELECTION.MoveDown (5, 1)
loWord.SELECTION.InsertRows(lnRows-1)
ENDIF
_CLIPTEXT = lc
lnStart=loTable.Cell(lnStartRows,1).RANGE.START
lnEnd=loTable.Cell(lnStartRows+lnRows-1,lnColumns).
RANGE.END
loWord.ActiveDocument.RANGE(lnStart,lnEnd).paste()
.SELECTION.TypeParagraph
loTable.Cell(1,1).RANGE.TEXT=''
ENDWITH

OpenWord.prg
_____________
LPARAMETERS lcDoc, llInVisible
DECLARE INTEGER SetForegroundWindow IN Win32API LONG HWND
DECLARE LONG FindWindow IN Win32API STRING lpClassName,STRING lpWindowName
TRY
loWord=GETOBJECT(,"WORD.APPLICATION")
CATCH TO loErr WHEN loErr.ERRORNO=1426
loWord=CREATEOBJECT("WORD.APPLICATION")
FINALLY
ENDTRY
IF TYPE('loWord.ActiveDocument')='O'
loWord.ActiveDocument.CLOSE
ENDIF
lnWindow = FindWindow(.NULL., loWord.NAME)
IF !EMPTY(lcDoc)
lcDoc=LOWER(FORCEEXT(ALLTRIM(lcDoc),'doc'))
IF FILE(lcDoc)
lcDoc=FULLPATH(lcDoc)
loWord.Documents.OPEN(lcDoc)
ELSE
loWord.Documents.ADD ("Normal", .F., 0)
lcPath=JUSTPATH(lcDoc)
IF NOT DIRECTORY(lcPath)
MD (lcPath)
ENDIF
loWord.ActiveDocument.SAVEAS(lcDoc)
ENDIF
ENDIF
loWord.VISIBLE=! llInVisible
IF lnWindow # 0
SetForegroundWindow(lnWindow)
ENDIF
RETURN

Mar 22, 2009 at 3:33 AM
Done !
Added a "Send to MSWORD" button in CHartsSample_New.scx

BTW, I think it's time to change the name of this form, since it's not new any more :-D

Thanks very much !

Regards

Cesar
Apr 23, 2009 at 12:01 PM
Hi Alex,

How could we get into contact? I pleasure with your print2Word to support me....

Koen