コンポですが、どんどん機能追加して使っていただきたいのでこちらに登録さ
せていただきます。このコンポはBatchMoveのように簡単にDataSetからExcel形
式ファイルを出力するコンポです。ただし、もちろんExcelクリエータを必要と
します。私が必要とする機能はこの程度で十分なのですが、ソースは簡単なの
でお好みに合わせてどんどん改良して使って下さい。

プロパティは以下の通りです。
  DestFileName -> 出力Excelファイル名
  RecordCount  -> 最大出力レコード数
  Source       -> 出力元DataSet（BatchMoveと同じです）
  SheetName    -> 出力シート名
  DefaultFont  -> デフォルトのフォント

-----ソースここから
unit Xls2Simp;

interface

uses Windows, SysUtils, Graphics, Classes, Controls, Db, DBCommon, Bde,
SMIntf,
  StdVCL, DBTables, DBConsts, BDEConst, Xls2, Dialogs;


type
  TXlsCrt2Simple = class(TComponent)
  private
    FDestFileName: String;
    FSource: TBDEDataSet;
    FRecordCount: Longint;
    FMovedCount: Longint;
    FSheetName: String;
    FDefaultFont: TFont;
    procedure SetSource(Value: TBDEDataSet);
    procedure SetFont(Value: TFont);
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute;
  public
    property MovedCount: Longint read FMovedCount;
  published
    property DestFileName: String read FDestFileName write
FDestFileName;
    property RecordCount: Longint read FRecordCount write FRecordCount
default 0;
    property Source: TBDEDataSet read FSource write SetSource;
    property SheetName: String read FSheetName write FSheetName;
    property DefaultFont: TFont read FDefaultFont write SetFont;
  end;

procedure Register;

implementation

{ TXlsCrt2Simple }

constructor TXlsCrt2Simple.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDefaultFont := TFont.Create;
end;

destructor TXlsCrt2Simple.Destroy;
begin
  FDefaultFont.Free;

  inherited Destroy;
end;

procedure TXlsCrt2Simple.Execute;
var
  ReturnCode: Boolean;
  i, Rows: Integer;
  TitleLen: Integer;
  hXlsID: Longint;
  SourceActive: Boolean;
  BookMark: TBookmarkStr;
begin
{ ===== Check DestFileName and Source. ===== }
  if ((DestFileName = '') or (Source = nil)) then begin
    DatabaseError(SInvalidBatchMove, Self);
  end;

  SourceActive := Source.Active;

  try
{ ===== Open Source DataSet. ===== }
    Source.DisableControls;
    Source.Open;
    Source.CheckBrowseMode;
    Source.UpdateCursorPos;
    if (SourceActive = True) then begin
      BookMark := Source.Bookmark;
    end;

{ ===== Create Excel Book File. ===== }
    ReturnCode := XlsCreateBook(PChar(ChangeFileExt(DestFileName,
'.xls')),
                                ver95, 1, hXlsID);
    if (ReturnCode = False) then begin
      DatabaseError('XlsCreateBook Error.', Self);
    end;

{ ===== Set Default Font. ===== }
    XlsPutDefFontName(PChar(DefaultFont.Name));
    XlsPutDefFontPoint(DefaultFont.Size);

{ ===== Set Sheet Name. ===== }
    XlsPutSheetName(PChar(SheetName));

    if (FRecordCount > 0) then begin
      Source.UpdateCursorPos;
      FMovedCount := FRecordCount;
    end else begin
      Check(DbiSetToBegin(Source.Handle));
      FMovedCount := MaxLongint;
    end;
    Source.CursorPosChanged;

{ ===== Put Column Title String and Set Width of Cell. ===== }
    Rows := 0;
    for i := 0 to Source.FieldCount - 1 do begin
      XlsPutStr(PChar(Source.Fields[i].DisplayLabel), Xls2.Pos(i, Rows,
i, Rows));

      TitleLen := Length(Source.Fields[i].DisplayLabel);
      if (TitleLen > Source.Fields[i].DisplayWidth) then begin
        XlsPutColWidth(TitleLen, Xls2.Pos(i, Rows, i, Rows));
      end else begin
        XlsPutColWidth(Source.Fields[i].DisplayWidth, Xls2.Pos(i, Rows,
i, Rows));
      end;
    end;

{ ===== Put Field Data. ===== }
    Inc(Rows);
    Source.First;
    while (Source.EOF = False) do begin
      for i := 0 to Source.FieldCount - 1 do begin
        case Source.Fields[i].DataType of
        ftString,
        ftFixedChar,
        ftMemo,
        ftTime,
        ftBoolean:begin
          XlsPutStr(PChar(Source.Fields[i].AsString),
                    Xls2.Pos(i, Rows, i, Rows));
          end;
        ftDate,
        ftDateTime: begin
          XlsPutStr(PChar(Source.Fields[i].AsString),
                    Xls2.Pos(i, Rows, i, Rows));
          end;
        ftSmallint,
        ftWord,
        ftAutoInc,
        ftInteger:begin
          XlsPutLong(Source.Fields[i].AsInteger,
                     Xls2.Pos(i, Rows, i, Rows));
          end;
        ftCurrency,
        ftFloat:begin
          XlsPutDouble(Source.Fields[i].AsFloat,
                       Xls2.Pos(i, Rows, i, Rows));
          end;
        ftUnknown,
        ftBCD,
        ftBytes,
        ftBlob,
        ftGraphic,
        ftTypedBinary,
        ftCursor:begin
          DatabaseErrorFmt(SParamBadFieldType, [Source.Fields
[i].FieldName], Source);
          end;
        else
          DatabaseErrorFmt(SParamBadFieldType, [Source.Fields
[i].FieldName], Source);
        end;
      end;

      Source.Next;
      Inc(Rows);
    end;

{ ===== Save and Close Excel Book File. ===== }
    XlsCloseBook(True);
  finally
    if (SourceActive = False) then begin
      Source.Close;
    end;
    if (SourceActive = True) then begin
      Source.Bookmark := BookMark;
    end;
    Source.EnableControls;
  end;
end;

procedure TXlsCrt2Simple.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then begin
    if (Source = AComponent) then begin
      Source := nil;
    end;
  end;
end;

procedure TXlsCrt2Simple.SetSource(Value: TBDEDataSet);
begin
  FSource := Value;
  if (Value <> nil) then begin
    Value.FreeNotification(Self);
  end;
end;

procedure TXlsCrt2Simple.SetFont(Value: TFont);
begin
  FDefaultFont.Assign(Value);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TXlsCrt2Simple]);
end;

end.
-----ソースここまで

=======================================
  02/10/2000(Thu) 12:59 こちん
  CQJ02557 or kochin@po.saganet.ne.jp
=======================================

Original document by こちん          氏 ID:(CQJ02557)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。