表单的内容用WORD形式保存

代码一:
<html>     
  <head>     
  <meta   http-equiv="Content-Type"   c>     
  <meta   name="GENERATOR"   c>     
  <meta   name="ProgId"   c>     
  <title>New   Page   1</title>     
  </head>     
  <body>     
  <Table   id="myData"   border=1   align=center>     
  <Tr   align=center>     
  <Td>表格转换</Td>     
  <Td>表格转换</Td>     
  <Td>表格转换</Td>     
  <Td>表格转换</Td>     
  </Tr>     
  <Tr   align=center>     
  <Td>表格转换</Td>     
  <Td>表格转换</Td>     
  <Td   align=right>表格转换</Td>     
  <Td>表格转换</Td>     
  </Tr>     
  <Tr   align=center>     
  <Td>表格转换</Td>     
  <Td>表格转换</Td>     
  <Td   align=right>表格转换</Td>     
  <Td>表格转换</Td>     
  </Tr>     
  <Tr   align=center>     
  <Td>表格转换</Td>     
  <Td>表格转换</Td>     
  <Td   align=right>表格转换</Td>     
  <Td>表格转换</Td>     
  </Tr>     
  </Table>     
  <center><input   type=button      value="转换成Wor     
  d文档"><script   language="vbscript">     
  Sub   buildDoc(theTemplate,intTableRows)     
  Dim   Table1     
  set   Table1   =   document.all.myData     
  row   =   Table1.rows.length     
  Set   objWordDoc   =   CreateObject("Word.Document")     
  ObjWordDoc.Application.Visible=True     
  Dim   theArray(4,4)     
  'Redim   Preserve   theArray(4,row)     
  colnum   =   Table1.rows(1).cells.length     
  for   i=0   to   row-1     
  for   j=0   to   colnum-1     
  theArray(j+1,i+1)   =   Table1.rows(i).cells(j).innerHTML     
  next     
  next     
  intNumrows   =   4     
  objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("转换     
  后的表格")     
  objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("")     
  objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("")     
  Set   rngPara   =   objWordDoc.Application.ActiveDocument.Paragraphs(1).Range     
  With   rngPara     
  .Bold   =   True     
  .ParagraphFormat.Alignment   =   1     
  .Font.Name   =   "Arial"     
  .Font.Size   =   12     
  End   With     
  Set   rngCurrent   =   objWordDoc.Application.ActiveDocument.Paragraphs(3).Range     
  Set   tabCurrent   =   ObjWordDoc.Application.ActiveDocument.Tables.Add(rngCurrent     
  ,intNumrows,4)     
  for   i   =   1   to   colnum     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(1).Cells(i).Range.Inser     
  tAfter   theArray(i,1)     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(1).Cells(i).Range.Parag     
  raphFormat.alignment=1     
  next     
  tabRow   =   2     
  For   j   =   2   to   intNumrows     
  'ObjWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Borders.Enable     
  =False     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(1).Range.     
  InsertAfter   theArray(1,j)     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(1).Range.     
  ParagraphFormat.alignment=1     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(2).Range.     
  InsertAfter   theArray(2,j)     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(2).Range.     
  ParagraphFormat.alignment=1     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(3).Range.     
  InsertAfter   FormatCurrency(theArray(3,j))     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(3).Range.     
  ParagraphFormat.alignment=2     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(4).Range.     
  InsertAfter   theArray(4,j)     
  'objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(4).Range     
  .InsertAfter   Chr(10)     
  objWordDoc.Application.ActiveDocument.Tables(1).Rows(tabRow).Cells(4).Range.     
  ParagraphFormat.alignment=1     
  tabRow   =   tabRow   +   1     
  Next     
  objWordDoc.Application.ActiveDocument.SaveAs   "tempSample.doc",   0,False,"",Tr     
  ue,"",False,False,False,   False,False     
  'objWordDoc.Application.printout()     
  End   Sub     
  </script>     
  </body>     
  </html>
   
代码二:
利用OLE對象   
   
  Option   Public   
  Option   Declare   
   
  '   WdGoToItem   Constants   
  Const   wdGoToLine%   =   3   
  Const   wdGoToLast%   =   -1   
   
  '   WdTableFormat   Constants   
  Const   wdTableFormatClassic2%   =   5   
   
  '   WdColorIndex   Constants   
  Const   wdAuto%   =   0   
  Const   wdBlack%   =   1   
  Const   wdBlue%   =   2   
  Const   wdBrightGreen%   =   4   
  Const   wdByAuthor%   =   -1   
  Const   wdDarkBlue%   =   9   
  Const   wdDarkRed%   =   13   
  Const   wdDarkYellow%   =   14   
  Const   wdGray25%   =   16   
  Const   wdGray50%   =   15   
  Const   wdGreen%   =   11   
  Const   wdNoHighlight%   =   0   
  Const   wdPink%   =   5   
  Const   wdRed%   =   6   
  Const   wdTeal%   =   10   
  Const   wdTurquoise%   =   3   
  Const   wdViolet%   =   12   
  Const   wdWhite%   =   8   
  Const   wdYellow%   =   7   
   
  '   WdParagraphAlignment   Constants   
  Const   wdAlignParagraphCenter%   =   1   
  Const   wdAlignParagraphLeft%   =   0   
  Const   wdAlignParagraphRight%=   2   
   
  Sub   Initialize   
   
  '   Set   the   Microsoft   Word   Object   
  Dim   varWrdApp   As   Variant   
  Set   varWrdApp   =   CreateObject(   "Word.Application"   )   
   
  '   Show   Word   
  varWrdApp.Visible   =   True   
   
  '   Add   a   new   document   
  varWrdApp.Documents.Add   
   
  '   Set   the   Word   Selection   
  Dim   varWrdSelection   As   Variant   
  Set   varWrdSelection   =   varWrdApp.Selection   
   
  '   Start   a   loop   to   create   sections   
  Dim   varWrdRange   As   Variant   
  Dim   varWrdTable   As   Variant   
  Dim   intPos   As   Integer   
  Dim   x   As   Integer   
  For   x%   =   1   To   5   '   loops   this   many   times   for   example's   sake   
   
  '   Find   the   end   of   the   Word   selection   
  intPos   =   varWrdSelection.End   
   
  '   Define   the   range   to   the   end   of   the   selection   and   add   a   new   table   
  Set   varWrdRange   =   varWrdApp.ActiveDocument.Range(   intPos,   intPos   )   
  Set   varWrdTable   =   varWrdApp.ActiveDocument.Tables.Add(   varWrdRange,   1,   1   )   '   simple   1   x   1   table   
  varWrdSelection.TypeText   "Heading   "   &   x%   
  With   varWrdTable   
  '   Set   the   shading   on   the   first   row   to   light   gray   
  .Rows(   1   ).Cells.Shading.BackgroundPatternColorIndex   =   wdGray25%   '   could   expand   to   multiple   rows   
  '   Bold   the   first   row   
  .Rows(   1   ).Range.Bold   =   True   
  '   Center   the   text   in   Cell   (1,1)   
  .Cell(   1,   1   ).Range.Paragraphs.Alignment   =   wdAlignParagraphCenter%   
  End   With   
   
  '   Put   the   cursor   at   the   end   of   the   selection   
  varWrdSelection.GoTo   wdGoToLine%,   wdGoToLast%   
   
  '   Add   text   to   document   
  Call   InsertLines(   varWrdSelection,   1)   
  varWrdSelection.TypeText   "Here's   line   one   of   Heading   "   &   x%   &   "'s   report."   
  Call   InsertLines(   varWrdSelection,   1)   
  varWrdSelection.TypeText   "Here's   line   two   of   Heading   "   &   x%   &   "'s   report."   
  Call   InsertLines(   varWrdSelection,   1)   
  varWrdSelection.TypeText   "Here's   line   three   of   Heading   "   &   x%   &   "'s   report."   
  Call   InsertLines(   varWrdSelection,   2)   
   
  Next   
   
   
  '   Delete   the   objects   
  Set   varWrdTable   =   Nothing   
  Set   varWrdRange   =   Nothing   
  Set   varWrdSelection   =   Nothing   
  Set   varWrdApp   =   Nothing   
   
  End   Sub   
   
  Sub   InsertLines(   varWrdSelection   As   Variant,   intNumLine   As   Integer   )   
   
  Dim   intCount   As   Integer   
   
  '   Insert   the   specified   number   of   blank   lines   
  For   intCount   =   1   To   intNumLine   
  varWrdSelection.TypeParagraph   
  Next   intCount   
   
  End   Sub
posted @ 2008-12-04 21:49  hannover  阅读(914)  评论(0编辑  收藏  举报