gridtoword.pas

delphi 读 excel ,并生成各种文件。

  end;

  Prompt := TLabel.Create(Panel);
  with Prompt do { Create Label }
  begin
    Parent := Panel;
    Left := 20;
    Top := 25;
    Caption := SConnectWord;
  end;

  ProgressBar := TProgressBar.Create(panel);
  with ProgressBar do { Create ProgressBar }
  begin
    Step := 1;
    Parent := panel;
    Left := 20;
    Top := 50;
    Height := 18;
    Width := 260;
  end;

  Button := TButton.Create(Panel);
  with Button do { Create Cancel Button }
  begin
    Parent := Panel;
    Left := 115;
    Top := 80;
    Caption := SCancel;
    OnClick := ButtonClick;
  end;

  ProgressForm.Show;
  ProgressForm.Update;
end; { TGridToWord.CreateProgressForm }

destructor TGridToWord.Destroy;
begin
  FTitle.Free;
  FBody.Free;
  FHeader.Free;
  FTableFormat.Free;
  inherited;
end; { TGridToWord.Destroy }

procedure TGridToWord.ExportDBGrid;
var
  Data              : TDataSet;
  DBGrid            : Tdxdbgrid;
  i, j              : integer;
  Bm                : pointer;
  OldBeforeScroll, OldAfterScroll: TDataSetNotifyEvent;
begin
  DBGrid := Tdxdbgrid(Grid);
  Data := DBGrid.DataSource.DataSet;
  with DBGrid do { Insert Table Header }
    for i := 1 to ColumnCount do      
      if Columns[i - 1].Visible then
        InsertHeader(1, i, Columns[i - 1].Caption);

  Bm := Data.GetBookmark; { Save Current Position }
  OldBeforeScroll := Data.BeforeScroll; { Save Old Before Scroll Event handle }
  OldAfterScroll := Data.AfterScroll; { Save Old After Scroll Event Handle }
  Data.DisableControls; { Disable Control }
  Data.BeforeScroll := nil;
  Data.AfterScroll := nil;
  if ShowProgress then ProgressBar.Max := Data.RecordCount;
  try
    i := 2;
    Data.First;
    while not Data.Eof do  { Process All record }
    begin
      with DBGrid do { Process one record }
        for j := 1 to ColumnCount do
          if Columns[j - 1].Visible then
            InsertBody(i, j, Columns[j - 1].Field.DisplayText);
      Inc(i);
      Data.Next;
      if Assigned(FOnProgress) then FOnProgress(Self);
      if ShowProgress then { Update Progress UI }
      begin
        ProgressBar.StepIt;
        Application.ProcessMessages;
        if Quit then exit;
      end;
    end;
  finally
    Data.BeforeScroll := OldBeforeScroll; { Restore Old Event Handle }
    Data.AfterScroll := OldAfterScroll;
    Data.GotoBookmark(Bm);
    Data.FreeBookmark(Bm);
    Data.EnableControls;
  end;
end; { TGridToWord.ExportDBGrid }

procedure TGridToWord.ExportStringGrid;
var
  i, j              : integer;
  SGrid             : TStringGrid;
begin
  SGrid := TStringGrid(Grid);
  if ShowProgress then
    ProgressBar.Max := SGrid.RowCount * SGrid.ColCount;
  for i := 1 to SGrid.RowCount do
    for j := 1 to SGrid.ColCount do
    begin
      if (i <= SGrid.FixedRows) or (j <= SGrid.FixedCols) then { Is Header? }
        InsertHeader(i, j, SGrid.Cells[j - 1, i - 1])
      else
        InsertBody(i, j, SGrid.Cells[j - 1, i - 1]);
      if Assigned(FOnProgress) then FOnProgress(Self);
      if ShowProgress then { Update Progress UI }
      begin
        ProgressBar.StepIt;
        Application.ProcessMessages;
        if Quit then Exit;
      end;
    end;
end; { TGridToWord.ExportStringGrid }

procedure TGridToWord.ExportToWord;
begin
  if Grid = nil then raise Exception.Create(SGridError);
  if ShowProgress then CreateProgressForm; { Create Progress Form }
  if not ConnectToWord then { Exit when error occer }
  begin
    if ShowProgress then FreeAndNil(ProgressForm);
    exit;
  end;

  try
    Screen.Cursor := crHourGlass;
    TForm(Owner).Enabled := False;
    WordApp.DisplayAlerts := False; { Disable Word Dialog }
    WordApp.ScreenUpdating := False; { Disable Word Screen Update }
    Quit := False;
    if ShowProgress then Prompt.Caption := SPromptExport;
    if Grid is Tdxdbgrid then
      ExportDBGrid
    else
      ExportStringGrid;
    if AutoSize then
      WordTable.AutoFitBehavior(wdAutoFitContent); { Auto Fit Table Size for Content }
    WordTable.Rows.Alignment := TableFormat.Align;
    with TableFormat do { Auto Fit Table Format }
      if Style <> tfDefault then
        WordTable.AutoFormat(Style, tfoBorders in Options, tfoShading in Options,
          tfoFont in Options, tfoColor in Options, tfoHeadingRows in Options,
          tfoLastRow in Options, tfoFirstColumn in Options, tfoLastColumn in Options,
          tfoAutoFit in Options);
    if WordFileName <> '' then WordDoc.SaveAs(WordFileName, SaveFormat);
  finally
    TForm(Owner).Enabled := True;
    Screen.Cursor := crDefault;
    if ShowProgress then FreeAndNil(ProgressForm); { Free Progress Form }
    WordApp.DisplayAlerts := True;
    WordApp.ScreenUpdating := True;

    if AutoExit then
      WordApp.Quit
    else
      WordApp.Visible := True;
    VarClear(WordTable);
    VarClear(WordDoc);
    VarClear(WordApp);
  end;
end; { TGridToWord.ExportToWord }

function TGridToWord.GetColCount: integer;
var
  i                 : integer;
begin
  Result := 0;
  if Grid is Tdxdbgrid then
  begin
    for i := 0 to Tdxdbgrid(Grid).ColumnCount - 1 do
      if Tdxdbgrid(Grid).Columns[i].Visible then
        Inc(Result);
  end;{
  else if Grid is TStringGrid then
    Result := TMyGrid(Grid).ColCount;   }
end; { TGridToWord.GetColCount }

function TGridToWord.GetRowCount: integer;
begin
  if Grid is Tdxdbgrid then
    Result := Tdxdbgrid(Grid).DataSource.DataSet.RecordCount + 1
  {else if Grid is TStringGrid then
    Result := TMyGrid(Grid).RowCount    }
  else
    Result := 0;
end; { TGridToWord.GetRowCount }

procedure TGridToWord.InsertBody(R, C: integer; Value: string);
begin
  SetFormat(WordTable.Cell(R, C), Value, Body);
end; { TGridToWord.InsertBody }

procedure TGridToWord.InsertHeader(R, C: integer; Value: string);
begin
  SetFormat(WordTable.Cell(R, C), Value, Header);
end; { TGridToWord.InsertHeader }

procedure TGridToWord.InsertTitle;
begin
  WordApp.Selection.EndKey;
  SetFormat(WordApp.Selection, Title.Caption, Title);
  WordApp.Selection.EndKey;
end; { TGridToWord.InsertTitle }

procedure TGridToWord.SetFont(Selection: OleVariant; Font: TFont);
begin
  Selection.Font.Name := Font.Name;
  Selection.Font.Color := ColorToRGB(Font.Color);
  Selection.Font.Size := Font.Size;
  Selection.Font.Italic := fsItalic in Font.Style;
  Selection.Font.Bold := fsBold in Font.Style;
  Selection.Font.Underline := fsUnderLine in Font.Style;
  Selection.Font.StrikeThrough := fsStrikeOut in Font.Style;
end; { TGridToWord.SetFont }

{ TParaFormat }

constructor TFormats.Create;
begin
  inherited Create;
  FAlign := waLeft;
  FUseFont := False;
  FFont := TFont.Create;
end; { TParaFormat.Create }

destructor TFormats.Destroy;
begin
  FFont.Free;
  inherited;
end; { TParaFormat.Destroy }

procedure TFormats.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end; { TParaFormat.SetFont }

procedure TGridToWord.SetFormat(Selection: Variant; Value: string;
  Formats: TFormats);
begin
  Selection.Range.InsertAfter(Value);
  Selection.Range.ParagraphFormat.Alignment := Formats.Align;
  if Formats.UseFont then SetFont(Selection.Range, Formats.Font);
end;

{ TTitle }

constructor TTitle.Create;
begin
  inherited;
  FAlign := waCenter;
end; { TTitle.Create }

{ THeader }

constructor THeader.Create;
begin
  inherited;
  FAlign := waCenter;
end; { THeader.Create }

{ TTableFormat }

constructor TTableFormat.Create;
begin
  inherited Create;
  FStyle := tfProfessional;
  FAlign := tlCenter;
  FOptions := [tfoBorders, tfoShading, tfoFont, tfoColor, tfoHeadingRows,
    tfoFirstColumn, tfoAutoFit];
end; { TTableFormat.Create }

end.