unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses DBTestUnit;

{$R *.DFM}

//=============================================================================
//  ワード操作フォームEx(の継承フォーム)をモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //起動時に表示する文書名
  plWordFormEx2.wdfFileFullPath := 'DBTest文書.doc';
  plWordFormEx2.ShowModal;
end;

end.

unit DBTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, plWordEx, StdCtrls, Buttons, ToolWin, ComCtrls, ExtCtrls, DB,
  DBTables, ADODB;

type
  TplWordFormEx2 = class(TplWordFormEx)
    Button1: TButton;
    ADOQuery1: TADOQuery;
    ADOConnection1: TADOConnection;
    procedure Button1Click(Sender: TObject);
    procedure btnFileSaveClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  plWordFormEx2: TplWordFormEx2;

implementation

uses ProgBarFornUnit;

{$R *.dfm}

//=============================================================================
//  データ読込み                                  　　　
//  Delphi付属のDBDEMOSのデータを各行に読込んでいく
//  表は予め，タイトル行とデータ行を一つだけ作成しておき，1行づつ増加しながら
//  読込んでいく　
//=============================================================================
procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
  DBPath      : String;
  ConnectStr  : String;
  TblNo       : Integer;
  RowCnt      : Integer;
  iRow        : Integer;
  RecCnt      : Integer;
  CustNo      : Integer;
  CompanyName : String;
  Zip         : String;
  Address     : String;
  Phone       : String;
  CustNoStr   : String;
begin
  if wdfWordApp.Documents.Count=0 then exit;

  Button1.Enabled := False;
  TblNo           := 1;

  //1番目の表をthisTblとする
  RowCnt := wdfWordDoc.Tables.Item(TblNo).Rows.Count;
  //表の行数が2を越えていたら既に読込みでいる
  //単票の場合は修正の意味で何回実行してもいいがこの場合は不要
  if RowCnt>2 then begin
     Application.MessageBox('データは既に読込まれています．　　　　',
                             '実行済み',
                              MB_OK + MB_ICONINFORMATION);
  end else begin

    //ADO関係の設定
    //まずデータベースファイルの場所をDBPathに代入
    DBPath := GetEnvironmentVariable('CommonProgramFiles');
    {$IF CompilerVersion > 18.49}
    DBPath := DBPath + '\CodeGear Shared\Data\dbdemos.mdb';
    {$ELSE}
    DBPath := DBPath + '\Borland Shared\Data\dbdemos.mdb';
    {$IFEND}

    ADOConnection1.Connected := False;
    //接続文字列の作成(パスワードなしの場合)
    ConnectStr                      := 'Provider=Microsoft.Jet.OLEDB.4.0';
    ConnectStr                      := ConnectStr + ';Data Source=' + DBPath;
    ADOConnection1.ConnectionString := ConnectStr;
    ADOConnection1.Mode             := cmReadWrite;
    ADOQuery1.Connection            := ADOConnection1;

    try
      with ADOQuery1 do begin
        SQL.Clear;
        SQL.Add('select Count(CustNo) as RecCnt from customer ');
        Open;
        RecCnt := ADOQuery1.FieldByName('RecCnt').AsInteger;
        Close;
        SQL.Clear;
        SQL.Add('select CustNo, Company, Zip, Addr1, Phone from customer');
        Open;
      end;
    except
      exit;
    end;

    ProgBarForm := TProgBarForm.Create(Self);
    ProgBarForm.Show;
    //Gaugeの最小値と最大値をセット
    ProgbarForm.Gauge1.Progress := 0;
    ProgBarForm.Gauge1.MaxValue := RecCnt;

    //画面更新の停止
    wdfWordApp.ScreenUpdating := False;

    //対象の表の開始行は2
    iRow:=2;
    while True do begin

      //データベースからデータを取得
      CustNo      := ADOQuery1.FieldByName('CustNo').AsInteger;
      CustNoStr   := IntToStr(CustNo);
      CompanyName := ADOQuery1.FieldByName('Company').AsString;
      Zip         := ADOQuery1.FieldByName('Zip').AsString;
      Address     := ADOQuery1.FieldByName('Addr1').AsString;
      Phone       := ADOQuery1.FieldByName('Phone').AsString;
      //それらのデータを該当するセルに挿入
      wdfPutCellText (TblNo, iRow, 1, CustNoStr);
      wdfPutCellText (TblNo, iRow, 2, CompanyName);
      wdfPutCellText (TblNo, iRow, 3, Zip);
      wdfPutCellText (TblNo, iRow, 4, Address);
      wdfPutCellText (TblNo, iRow, 5, Phone);
      //次のデータへ
      ADOQuery1.Next;
      //データが無ければ終了
      if ADOQuery1.Eof then break;

      Application.ProcessMessages;
      //行を追加
      wdfAddRow(TblNo);
      iRow := iRow+1;
      //進行程度をゲージに反映
      ProgBarForm.Gauge1.Progress := iRow;
      ProgBarForm.Update;
    end;
    ProgBarForm.Close;

    //画面更新の再開
    wdfWordApp.ScreenUpdating := True;
    ADOQuery1.Close;
  end;

  wdfWordDoc.Saved := True;
  Button1.Enabled  := True;

  FreeAndNil(ProgBarForm);
end;

//=============================================================================
//  保存時は文書名自動生成
//=============================================================================
procedure TplWordFormEx2.btnFileSaveClick(Sender: TObject);
var
  S : String;
begin
  S := FormatDateTime('yyyy"年"mm"月"dd"日_"', Now);
  SaveDialog1.FileName := S + 'DBTest.doc';

  //継承元のボタンクリックを実行
  inherited;
end;

end.

unit ProgBarFornUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, Gauges;

type
  TProgBarForm = class(TForm)
    Panel2: TPanel;
    Gauge1: TGauge;
    Panel1: TPanel;
    Image1: TImage;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMKillFocus(var Msg:TWMSetFocus); message WM_KILLFOCUS;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
   ProgBarForm: TProgBarForm;  

implementation

uses DBTestUnit;

{$R *.DFM}

{ TProgBarForm }

//=============================================================================
//  このFormをplWordForm1より前面に表示           　　　
//=============================================================================
procedure TProgBarForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WndParent := plWordFormEx2.Handle;
end;

//=============================================================================
//  このFormを表示している間はFocus移動禁止       　　　
//=============================================================================
procedure TProgBarForm.WMKillFocus(var Msg: TWMSetFocus);
begin
  inherited;

  Self.BringToFront;
end;

end.