Delphi Programming Forum
C++Builder  |  Delphi  |  FireMonkey  |  C/C++  |  Free Pascal  |  Firebird
볼랜드포럼 BorlandForum
 경고! 게시물 작성자의 사전 허락없는 메일주소 추출행위 절대 금지
델파이 포럼
Q & A
FAQ
팁&트릭
강좌/문서
자료실
컴포넌트/라이브러리
FreePascal/Lazarus
볼랜드포럼 홈
헤드라인 뉴스
IT 뉴스
공지사항
자유게시판
해피 브레이크
공동 프로젝트
구인/구직
회원 장터
건의사항
운영진 게시판
회원 메뉴
북마크
델마당
볼랜드포럼 광고 모집

델파이 Q&A
Delphi Programming Q&A
[15317] [질문]ClientDataSet의 내용을 엑셀로 보낼때 에러입니다.
thinkstone [magicljm] 2375 읽음    2014-10-18 01:50
인터넷 예제를 테스트 하는데

Sheet 1개만 생성하는덴 문제가 없는데

여러개의 sheet를 가진 파일로 저장하려고

소스를 수정해보니 "잘못된 색인입니다." 라는에러가......

잘 몰라서 그러는데 소스 좀 봐주세요. ㅠㅠ
///////////////////////////////////////////////////////////////////////////////////////
(덧붙인 부분입니다. 파일 하나에 Sheet1,Sheet2 만들려고요.)
    SaveToExcelFile(const AFileName: TFileName); 에서

    Excel.Workbooks.Add(Worksheet);
    Sheet2 := Excel.Workbooks[1].WorkSheets[2];
    Sheet2.Name := 'Sheet2';
    Sheet.Range[RefToCell(1, 1), RefToCell(DataRows, DataCols)].Value := Data;
////////////////////////////////////////////////////////////////////////////////////

//소스///////////////////////////////////////////////

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, DBGrids, DB, DBClient,
  DateUtils, ComObj;

type
  TForm1 = class(TForm)
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure SaveToCSVFile(const AFileName: TFileName);
    procedure SaveToExcelFile(const AFileName: TFileName);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function RefToCell(ARow, ACol: Integer): string;
begin
  Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  case RadioGroup1.ItemIndex of
    0:
    begin
      SaveDialog1.Filter := 'Excel File|*.xls';
      if SaveDialog1.Execute then
        SaveToExcelFile(SaveDialog1.FileName);
    end;
    1:
    begin
      SaveDialog1.Filter := 'Comma Delimited|*.csv';
      if SaveDialog1.Execute then
        SaveToCSVFile(SaveDialog1.FileName);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  CMonths: array[1..12] of string = (
    'Jan', 'Feb', 'March', 'April', 'May', 'June', 'July', 'August', 'Sept',
    'Oct', 'Nov', 'Dec');
var
  I, J: Integer;
begin
  with ClientDataSet1.FieldDefs do
  begin
    Add('Year', ftInteger, 0);
    Add('Month', ftString, 12, True);
    Add('EEPoints', ftInteger, 0);
  end;
  ClientDataSet1.CreateDataSet;

  Randomize;
  for I := 2008 to 2010 do
    for J := 1 to 12 do
    begin
      ClientDataset1.Append;
      ClientDataset1.FieldByName('Year').AsInteger := I;
      ClientDataset1.FieldByName('Month').AsString := CMonths[J];
      ClientDataset1.FieldByName('EEPoints').AsInteger := Random(25000);
      ClientDataset1.Post;
    end;
end;

procedure TForm1.SaveToCSVFile(const AFileName: TFileName);
var
  RowValue: string;
  DataCols, I: Integer;
  Stream: TMemoryStream;
  function DblQuotedStr(const Value: string): string;
  begin
    Result := '"' + Value + '"';
  end;
  function AddToString(const ABaseValue, AFieldValue: string): string;
  begin
    if ABaseValue = '' then
       Result := DblQuotedStr(AFieldValue)
    else
      Result := ABaseValue + ',' + DblQuotedStr(AFieldValue);
  end;
begin
  DataCols := ClientDataset1.FieldCount;

  Stream := TMemoryStream.Create;
  try
    //write the titles
    for I := 0 to DataCols - 1 do
      RowValue := AddToString(RowValue, ClientDataset1.Fields[I].FieldName);
    RowValue := RowValue + #13#10;
    Stream.Write(Pointer(RowValue)^, Length(RowValue) * SizeOf(Char));

    //write data
    ClientDataset1.DisableControls;
    ClientDataset1.First;
    while not ClientDataset1.Eof do
    begin
      RowValue := '';
      for I := 0 to DataCols - 1 do
        RowValue := AddToString(RowValue, ClientDataset1.Fields[I].AsString);
      RowValue := RowValue + #13#10;
      Stream.Write(Pointer(RowValue)^, Length(RowValue) * SizeOf(Char));

      ClientDataset1.Next;
    end;

    Stream.SaveToFile(AFileName);
  finally
    FreeAndNil(Stream);
  end;
end;

procedure TForm1.SaveToExcelFile(const AFileName: TFileName);
const
  Worksheet = -4167;
var
  Row, Col: Integer;
  Excel, Sheet, Data,Sheet2: OLEVariant;
  I, J, DataCols, DataRows: Integer;
begin
  DataCols := ClientDataset1.FieldCount;
  DataRows := ClientDataset1.RecordCount + 1; //1 for the title

  //Create a variant array the size of your data
  Data := VarArrayCreate([1, DataRows, 1, DataCols], varVariant);

  //write the titles
  for I := 0 to DataCols - 1 do
    Data[1, I+1] := ClientDataset1.Fields[I].FieldName;

  //write data
  J := 1;
  ClientDataset1.First;
  while (not ClientDataset1.Eof) and (J < DataRows) do
  begin
    for I := 0 to DataCols - 1 do
      Data[J + 1, I + 1] := ClientDataset1.Fields[I].Value;
    Inc(J);
    ClientDataset1.Next;
  end;

  //Create Excel-OLE Object
  Excel := CreateOleObject('Excel.Application');
  try
    //Don't show excel
    Excel.Visible := False;

    Excel.Workbooks.Add(Worksheet);
    Sheet := Excel.Workbooks[1].WorkSheets[1];
    Sheet.Name := 'Sheet1';
    //Fill up the sheet
    Sheet.Range[RefToCell(1, 1), RefToCell(DataRows, DataCols)].Value := Data;
////덧붙인 부분(에러 나는 곳)//////////////////////////
    Excel.Workbooks.Add(Worksheet);
    Sheet2 := Excel.Workbooks[1].WorkSheets[2];
    Sheet2.Name := 'Sheet2';
    Sheet.Range[RefToCell(1, 1), RefToCell(DataRows, DataCols)].Value := Data;
///////////////////////////////////////////////////////////////////////////
    //Save Excel Worksheet
    try
      Excel.Workbooks[1].SaveAs(AFileName);
    except
      on E: Exception do
        raise Exception.Create('Data transfer error: ' + E.Message);
    end;
  finally
    if not VarIsEmpty(Excel) then
    begin
      Excel.DisplayAlerts := False;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;

end.

     

+ -

관련 글 리스트
15317 [질문]ClientDataSet의 내용을 엑셀로 보낼때 에러입니다. thinkstone 2375 2014/10/18
15318     Re:[질문]ClientDataSet의 내용을 엑셀로 보낼때 에러입니다. thinkstone 4159 2014/10/20
Google
Copyright © 1999-2015, borlandforum.com. All right reserved.