How to create a categorized table in Word 97 or in Office Word 2003 from Visual FoxPro for Windows 5.0 and later versions

This article was previously published under Q180901
This article has been archived. It is offered "as is" and will no longer be updated.
SUMMARY
This article demonstrates how to create and format a table in MicrosoftWord 97 or Microsoft Office Word 2003 from Visual FoxPro for Windows 5.0 and later using OLE automation.The table contains a grouping field, for instance, a state, company orcustomer sales ID. This example groups by country or region. The data for the Word document will be gathered using an SQL query into a temporary cursor.
MORE INFORMATION
For this code to work correctly, the first field in the query must be thegroup field used in the Word 97 report. For instance, if it is necessary touse all fields in a table for the report, but the field that is to be thegroup field is not the first field in the source table, then issue a querysimilar to this:
SELECT state,* FROM Customer GROUP BY state, custid INTO CURSOR category				
This forces the group field, state in this example, to be the first fieldin the queried result.

NOTE: This code only works with the Service Release-1 for Word 97. Usingprior versions of Word 97 causes a "Type Mismatch" and other OLE errors.

Create a program and enter the code given below. When the code is executed,the user will see two prompts. These prompts ask the user how the Worddocument should be formatted. The first prompt asks whether the user wantsto have each grouping on its own page or not. The second question asks ifthe user wants underlines between the rows of the table or not. Thesequestions are merely for viewing preferences and to show how the programmermay format the table in Word with these and other preferences.

Here is the sample code:
    */ 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 categoryendif   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 /*				
REFERENCES
For more information about obtaining Word for Windows 97 Service Release -1, please see the following article in the Microsoft Knowledge Base:
172475 How To Obtain and Install MS Office 97 SR-1
Microsoft Word Visual Basic Help

(c) Microsoft Corporation 1998, All Rights Reserved.Contributions by Dean Christopher, Microsoft Corporation
Properties

Article ID: 180901 - Last Review: 02/21/2014 00:28:50 - Revision: 2.4

  • Microsoft Visual FoxPro 5.0 Standard Edition
  • Microsoft Visual FoxPro 5.0a
  • Microsoft Visual FoxPro 6.0 Professional Edition
  • Microsoft Visual FoxPro 7.0 Professional Edition
  • Microsoft Visual FoxPro 8.0 Professional Edition
  • Microsoft Visual FoxPro 9.0 Professional Edition
  • Microsoft Word 97 Service Pack 1
  • Microsoft Office Word 2003
  • kbnosurvey kbarchive kbcode kbhowto kbinterop KB180901
Feedback