导出DataSet中数据为Word文件之VBA实现篇 |
| 引言：
由于项目中有客户要求将程序中的数据库导出为Word的.Doc文件进行编辑和打印，所以忙乎了一个上午写了一个通用的类，不敢私藏，拿出来共享之。 |
|
程序中借用delphi中servers控件的相关word控件，通过OLEServer与Word进行通信，并用VBA的方法画出一个表格，然后遍历数据库将字段值逐个写进表格单元。
//========================================================// 重构Create方法（参数aDataSet用于传入一个TdataSet）： constructor TwsWord.Create(aDataSet: TDataSet); begin inherited Create; FDataSet:= aDataSet; if not Assigned(FWordApp) then begin FWordApp := TWordApplication.Create(nil); end; if not Assigned(FWordDoc) then begin FWordDoc := TWordDocument.Create(nil); end; end;
声明一个public成员，用以外部调用，有两个参数（fileName为保存的文件名；wsVisible决定Word是否显示）： procedure TwsWord.SaveAsWord(const FileName: String; wsVisible: Boolean); begin SavetoFile(FileName, wsVisible); end; //=========================================================// 声明一个private成员，用以内部集中调用，用以外部调用的过程通过它与内部通信： procedure TwsWord.SavetoFile(FileName: OLEVariant; wsVisible: Boolean); begin OpenWord(wsVisible); ReadDataset; FWordDoc.SaveAs(fileName); if wsVisible= False then begin FWordApp.Quit; end; FWordApp.Disconnect; end; 打开Word之后，进行资料读取并导出 //================================================= procedure TwsWord.ReadDataset; var wsSel: WordSelection; i, j, k, iTitleRow:integer; iRangeEnd: LongInt; wsTable: Variant; wsRange: Range; FCols:integer; FRows:Integer; begin wsSel := FWordApp.Selection ; FWordFont.ConnectTo(wsSel.Font); //用以改变字体样式等，暂未使用 wsSel.TypeText('This is a PageTitle'); //段内容 wsSel.TypeParagraph; //分段 wsSel.TypeText(''); wsSel.TypeParagraph; FWordApp.ScreenUpdating := False; //关闭自动刷新 iTitleRow := 1; //标题列，第一行 if FDataSet.Active= True then begin FCols := FDataSet.FieldCount ; FRows := FDataSet.RecordCount+1; end; wsRange := FWordDoc.Paragraphs.item(2).Range; wsTable := FWordDoc.Tables.Add(wsRange,FRows, FCols, EmptyParam, EmptyParam); //画表格 wsTable.columns.AutoFit; k:=1; FDataset.DisableControls; for i:=0 to FDataSet.FieldCount-1 do begin wsTable.Cell(1,k).Range.InsertAfter(fDataSet.Fields[i].FieldName); inc(k); end; k:=2; FDataSet.First; while not FDataSet.Eof do begin for j:=0 to FDataSet.FieldCount-1 do begin if (FDataSet.Fields[j].DataType=ftBlob) then wsTable.Cell(k,j+1).Range.InsertAfter('') else wsTable.cell(k,j+1).Range.insertAfter(fDataSet.Fields[j].AsString); end; inc(k); FDataset.Next; end; FDataSet.First; Fdataset.EnableControls; FWordApp.ScreenUpdating := True; end; 调用实例： procedure TForm1.Button1Click(Sender: TObject); begin try with TwsWord.Create(AdoTable1) do begin SaveAsWord('C:\wsWord.doc',False); end; except showmessage('Error'); end; end; 通过以上方法，能较为方便的导出资料至Word中，如果你也正在寻求这方面的解决方法，希望能给你提供一点点思路：） 源代码及演示下载请点击这里
|
|
作者声明：转载请注明文章出处
|
