*/ Begin program code /*
CLEAR
SET TALK OFF
SET CONSOLE OFF
ctempfield = "" && Variable to hold group category.
headings_added = .F.
newgrouppage = .F.
* Make sure the FIRST field in the SELECT is the field the report
* is categorized by. The Customer table is located in the
* \VFP\Samples\Data folder. In Visual FoxPro 6.0, the Customer table is
* in the Microsoft Visual Studio\Common\Samples\Data folder.
** We toggle the value of SET ENGINEBEHAVIOR in VFP 8.0 and
** 9.0 to allow this SELECT-SQL command to function.
** For more information on the SET ENGIENBEHAVIOR command,
** see the VFP Help file.
IF "8.0"$VERSION() OR "9.0"$VERSION()
x=SET("enginebehavior")
SET ENGINEBEHAVIOR 70
SELECT country, company, contact, title,maxordamt,phone;
FROM HOME()+"Samples\Data\testdata!customer" GROUP BY;
country,cust_id INTO CURSOR category
SET ENGINEBEHAVIOR x
ELSE
SELECT country, company, contact, title,maxordamt,phone;
FROM HOME()+"Samples\Data\testdata!customer" GROUP BY;
country,cust_id INTO CURSOR category
endif
IF _TALLY > 0
oWord = CREATEOBJECT("Word.Application")
oWord.Documents.Add
owRange = oWord.Activedocument.Range(0,0)
numcols = FCOUNT()-1 && Get number of fields for detail section
oWord.Activedocument.Tables.Add(owRange, 1, numcols)
* First prompt, separate pages for each group.
nanswer = messagebox("Put each group on a new page?",36,;
"Sepatate Pages")
DO CASE
CASE nanswer = 6 && Yes
newgrouppage = .T.
CASE nanswer = 7 && No
headings_added = .F.
ENDCASE
WAIT WINDOW "Please wait while the data is formatted in Word.";
+ CHR(13)+"This may take several minutes..." NOWAIT
DO WHILE !EOF()
ctempfield = EVAL(FIELD(1)) && Set 1st field in table as category
WITH oWord
.Selection.Font.Reset
.Selection.TypeText(EVAL(FIELD(1)))
.Selection.SelectRow
.Selection.ParagraphFormat.Alignment = 1
.Selection.Font.Name = "Arial"
.Selection.Font.Size = 16
.Selection.Font.Bold = .T.
.Selection.SelectRow
.Selection.Cells.Merge
.Selection.MoveRight(12)
.Selection.Cells.Split(1,numcols)
IF NOT headings_added && Put at least one heading in document
.Selection.MoveRight(12)
FOR i = 2 TO FCOUNT()
.Selection.Font.Italic = .T.
.Selection.ParagraphFormat.Alignment = 1
.Selection.Font.Name = "Times New Roman"
.Selection.Font.Size = 8
.Selection.TypeText((FIELD(i)))
.Selection.MoveRight(12)
headings_added = .T.
ENDFOR
ENDIF
FOR i = 2 TO FCOUNT()
curfield = EVAL(FIELD(i))
* Check data type. Does not check Double, Float, Integer, General, Memo.
IF TYPE((FIELD(i)))<>"C"
DO CASE
CASE TYPE((FIELD(i))) = "D" && Date field
curfield = DTOC((FIELD(i)))
CASE TYPE((FIELD(i))) = "N" && Numerical
curfield = STR((FIELD(i)))
CASE TYPE((FIELD(i))) = "Y" && Currency
curfield = STR(EVAL(FIELD(i)),8,2)
CASE TYPE((FIELD(i))) = "L" && Logical
IF curfield
curfield = "True"
ELSE
curfield = "False"
ENDIF
CASE TYPE((FIELD(i))) = "T" && DateTime
curfield = TTOC(EVAL(FIELD(i)))
ENDCASE
.Selection.Font.Reset
.Selection.TypeText(curfield)
ELSE
.Selection.Font.Reset
.Selection.TypeText(curfield)
ENDIF
.Selection.Font.Reset
.Selection.MoveRight(12)
ENDFOR
SKIP
ENDWITH
DO WHILE ctempfield = EVAL(FIELD(1)) && Get other like records.
WITH oWord
FOR i = 2 TO FCOUNT()
curfield = EVAL(FIELD(i))
IF TYPE((FIELD(i)))<>"C"
DO CASE
CASE TYPE((FIELD(i))) = "D"
curfield = DTOC((FIELD(i)))
CASE TYPE((FIELD(i))) = "N"
curfield = STR((FIELD(i)))
CASE TYPE((FIELD(i))) = "Y"
curfield = STR(EVAL(FIELD(i)),8,2)
CASE TYPE((FIELD(i))) = "L"
IF curfield
curfield = "True"
ELSE
curfield = "False"
ENDIF
CASE TYPE((FIELD(i))) = "T"
curfield = TTOC(EVAL(FIELD(i)))
ENDCASE
.Selection.TypeText(curfield)
ELSE
.Selection.TypeText(curfield)
ENDIF
.Selection.MoveRight(12)
ENDFOR
ENDWITH
SKIP
ENDDO
IF RECNO() > RECCOUNT() && Prevents an empty table/cells.
EXIT
ELSE
IF newgrouppage
headings_added = .F. && False: add headings to each page.
oWord.Selection.InsertBreak(2) && Page break each category.
ENDIF
ENDIF
ENDDO
oWord.Selection.SelectRow && Ensures no extra rows in the table.
oWord.Selection.Rows.Delete
* This section underlines or turns off all lines in the table.
nanswer = MESSAGEBOX("Turn off underlines Y/N",36,;
"No underlines in the table?")
DO CASE
CASE nanswer = 6 && Yes, turn off all underlines.
WAIT WINDOW 'Formating table with no underlines in the table.';
NOWAIT
WITH oWord
For Each aTable In .ActiveDocument.Tables && Format all tables.
aTable.Borders(-1).LineStyle = 0 && Top border.
aTable.Borders(-2).LineStyle = 0 && Left
aTable.Borders(-3).LineStyle = 0 && Bottom
aTable.Borders(-4).LineStyle = 0 && Right
aTable.Borders(-5).LineStyle = 0 && Horizontal
aTable.Borders(-6).LineStyle = 0 && Vertical
aTable.Borders.Shadow = 0
ENDFOR
ENDWITH
CASE nanswer = 7 && Number just underlines.
WITH oWord
WAIT WINDOW 'Formating table with underlines between records.';
NOWAIT
For Each aTable In .ActiveDocument.Tables && Format each table.
aTable.Borders(-1).LineStyle = 0 && Top border
aTable.Borders(-2).LineStyle = 0 && Left
aTable.Borders(-3).LineStyle = 1 && Bottom
aTable.Borders(-4).LineStyle = 0 && Right
aTable.Borders(-5).LineStyle = 1 && Horizontal
aTable.Borders(-6).LineStyle = 0 && Vertical
aTable.Borders.Shadow = 0
ENDFOR
ENDWITH
oWord.ActiveWindow.View.TableGridlines = .F. && No table gridlines
ENDCASE
* Get the number of pages in the Word report. The code adds the report
* headings to the document header when the user chooses not to have the
* report categories print on separate pages. Makes viewing groups
* headings easier on other pages.
numpages = oWord.ActiveDocument.ComputeStatistics(2)
IF numpages > 1 AND NOT newgrouppage
WITH oWord
.Selection.MoveDown
.ActiveWindow.ActivePane.View.Type = 3 && Put Word in Page view
.ActiveWindow.ActivePane.View.SeekView = 9 && Open header.
.Selection.ParagraphFormat.TabStops.ClearAll && Clear tabs.
* Printed header width is computed by subtracting margins
* from page width. The margins are divided by 72. Word stores
* these values as points; i.e. 72points/inch.
pagewidth = 8.5-(.ActiveDocument.PageSetup.RightMargin+;
.ActiveDocument.PageSetup.LeftMargin)/72
tabspace = (pagewidth/(numcols))*72 && Convert inches to points
tabstops = tabspace
FOR i = 2 TO FCOUNT()
.Selection.Font.Italic = .T. && Format heading captions.
.Selection.ParagraphFormat.Alignment = 1
.Selection.Font.Name = "Times New Roman"
.Selection.Font.Size = 8
.Selection.TypeText((FIELD(i)))
.Selection.TypeText(chr(9)) && Tab to set the next heading.
.Selection.ParagraphFormat.TabStops.Add(tabstops) && Tab
tabstops = tabstops+tabspace
ENDFOR
ENDWITH
ENDIF
WITH oWord
.ActiveWindow.View.Type = 3 && Switch to page view. Normal view=1
.ActiveWindow.ActivePane.View.SeekView = 0 && Open main document.
.Selection.Homekey(6) && Go to top of document.
.Visible = .T. && Make Word visible.
.Application.Activate && Bring Word forward.
.WindowState = 0 && Show Word in normal state. Maximized=1
.ActiveWindow.ActivePane.View.ShowAll = 0 && No nonprinting items.
ENDWITH
ELSE
=MESSAGEBOX("There were no records in the query.",16,;
"Empty Query")
ENDIF
*/ End program code /*
回到顶端
