delphi--csv,txt文本转换成excel

来源:互联网 发布:arta软件 用法 编辑:程序博客网 时间:2024/04/29 18:20

由于系统使用导出的格式是csv,但是如果数字的长度太长的话,用excle打开会用科学技术法自动截断了。所以开发了一个转换程序。

unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ComObj, StrUtils, WinSkinData,  WinSkinStore, Gauges, ShellApi, ClipBrd;type  TForm1 = class(TForm)    OpenDialog1: TOpenDialog;    SaveDialog1: TSaveDialog;    Panel1: TPanel;    Edit1: TEdit;    Edit2: TEdit;    Button1: TButton;    Button2: TButton;    Button3: TButton;    StatusBar1: TStatusBar;    SkinData1: TSkinData;    Timer1: TTimer;    Gauge1: TGauge;    progressBar: TProgressBar;    procedure Button1Click(Sender: TObject);    procedure Button2Click(Sender: TObject);    procedure Button3Click(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;      Panel: TStatusPanel; const Rect: TRect);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    progressBarRect:TRect; // 进度条组件的尺寸  public    { Public declarations }    procedure   DropFiles(var   Message:   TMessage);   message   WM_DropFiles;  end;var  Form1: TForm1;implementation{$R *.dfm}procedure   TForm1.DropFiles(var   Message:   TMessage);    var        i,l:   Integer;      p:   array[0..254]   of   Char;      s:   String;  begin      i   :=   DragQueryFile(Message.wParam,   $FFFFFFFF,   nil,   0);        for   i   :=   0   to   i   -   1   do   begin            DragQueryFile(Message.wParam,   i,   p,   255);            //ShowMessage(StrPas(p));          s :=  StrPas(p);          l := Pos('.csv',s);          if (l > 0) then            Edit1.Text := StrPas(p)          else            ShowMessage('请选择csv文件!');      end;    end;   procedure TForm1.Button1Click(Sender: TObject);beginStatusBar1.Panels[0].Text :='';OpenDialog1.Execute;Edit1.Text := OpenDialog1.FileName;end;procedure TForm1.Button2Click(Sender: TObject);beginStatusBar1.Panels[0].Text:='';SaveDialog1.Execute;Edit2.Text := SaveDialog1.FileName;end;procedure TForm1.Button3Click(Sender: TObject);var  Excel,WorkBook,xlQuery,A:Variant;  f:TextFile;  i,j,k,b,nLen:integer;  s,xlsFile:string;  pc:PChar;  StepCount : Integer;  vSL:   TStringList;begin    try          if   not   FileExists(Edit1.Text)   then          begin             StatusBar1.Panels[0].Text:='请选择CSV文件!!!!!!!';             exit;          end;          xlsFile := Edit1.Text;          xlsFile := AnsiReplaceText(xlsFile,'.csv','.xls');          if xlsFile = '' then          begin             StatusBar1.Panels[0].Text:='请选择另存为Excel!!!!!!!';             Exit;          end;          //AssignFile(f,Edit1.Text);          //Reset(f);          vSL   :=   TStringList.Create;          //vSL.Delimiter=',';          vSL.LoadFromFile(Edit1.Text);          try            Excel:=CreateOleObject('Excel.Application');            WorkBook:=CreateOleobject('Excel.Sheet');          except            ShowMessage('您的机器里未安装Microsoft Excel.');            Exit;          end;          //动态创建进度条组件progressBar          StepCount:=vSL.Count; // 循环的总数目          timer1.Enabled:=true;          with progressBar do          begin          // 先确定进度条组件的尺寸和位置          Top:=ProgressBarRect.Top;          Left:=ProgressBarRect.Left;          Width:=ProgressBarRect.Right-ProgressBarRect.Left;          Height:=ProgressBarRect.Bottom-ProgressBarRect.Top;          Parent:=StatusBar1; // parent属性设置为状态栏组件          Visible:=True; // 使进度条可见                    Min:=0;// 设定进度条的范围和步长          Max:=StepCount div 300;          Step:=1;          end;          //pb.Visible := true;          WorkBook := Excel.workbooks.add;          Excel.worksheets[1].activate;          Excel.Visible:=false;//          Clipboard.AsText:=vSL.Text;          //计算有多少列          s:=vSL[0];          pc := PChar(s);          k:=0;          b:=1;          j:=1;          nLen := strlen(pc);          while k<nLen do              begin;                if pc[k] = ',' then                begin                  inc(j);                end;                inc(k);          end;        A:=VarArrayCreate([0,j],varVariant);        for   i:=0   to   j   do             A[i]:=2;        xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);        //xlQuery.Name := '';        xlQuery.FieldNames := True;        xlQuery.RowNumbers := False;        xlQuery.FillAdjacentFormulas := False;        xlQuery.PreserveFormatting := True;        xlQuery.RefreshOnFileOpen := False;        //xlQuery.RefreshStyle := 'xlInsertDeleteCells';        xlQuery.SavePassword := False;        xlQuery.SaveData := True;        xlQuery.AdjustColumnWidth := True;        xlQuery.RefreshPeriod := 0;        xlQuery.TextFilePromptOnRefresh := False;        xlQuery.TextFilePlatform := 936;        xlQuery.TextFileStartRow := 1;        //xlQuery.TextFileParseType := 'xlDelimited';        //xlQuery.TextFileTextQualifier := 'xlTextQualifierDoubleQuote';        xlQuery.TextFileConsecutiveDelimiter := False;        xlQuery.TextFileTabDelimiter := False;        xlQuery.TextFileSemicolonDelimiter := False;        xlQuery.TextFileCommaDelimiter := True;        xlQuery.TextFileSpaceDelimiter := False;        xlQuery.TextFileColumnDataTypes := A;        xlQuery.TextFileTrailingMinusNumbers := True;        xlQuery.Refresh;          if   FileExists(xlsFile)   then              DeleteFile(xlsFile);//          Excel.worksheets[1].Paste;          WorkBook.SaveAs(xlsFile);          StatusBar1.Panels[0].Text:='转换成功!!!!!!!';          progressBar.Visible:=false;    finally      if   vSL<>nil then        vSL.Free;      if not VarIsEmpty(WorkBook) then WorkBook.close;      if not VarIsEmpty(Excel) then Excel.quit;      //if not VarIsEmpty(A) then varfree(A);      timer1.Enabled:=false;    end;end;procedure TForm1.FormPaint(Sender: TObject);beginStatusBar1.Panels[0].Text:='中国建设银行版权所有..........';end;procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;  Panel: TStatusPanel; const Rect: TRect);beginprogressBarRect:=Rect;end;procedure TForm1.FormCreate(Sender: TObject);beginDragAcceptFiles(Handle,   True);end;procedure TForm1.Timer1Timer(Sender: TObject);begin     progressBar.Stepit;               //Application.ProcessMessages;          //Sleep(ProgressBar.Position);end;end.

原来使用的是

         for i:=1 to StepCount do          begin            //Readln(f,s);            progressBar.Stepit;// 循环使进度显示条累加            s:=vSL[i-1];            pc := PChar(s);            k:=0;            b:=1;            j:=0;            nLen := strlen(pc);            while k<nLen do              begin;                if pc[k] = ',' then                begin                  inc(j);                  Excel.cells[i,j].NumberFormat:='@';                  Excel.cells[i,j].value:=Copy(s,b,k-b+1);                  b:=k+2;                end;                inc(k);            end;            inc(j);            Excel.cells[i,j].NumberFormat:='@';            Excel.cells[i,j].value:=Copy(s,b,k-b+1);          end;上面的代码是遍历整个文件,判断是否有逗号,然后对每个格子插入数据。这样做的效率很低,3千多行的数据转换用了5分钟。后来使用vba,先用excle录制了一段外部数据导入的宏。
Sub Macro3()'' Macro3 Macro' 宏由 ZHL 录制,时间: 2008-7-3''    Cells.Select    With ActiveSheet.QueryTables.Add(Connection:= _        "TEXT;C:/Documents and Settings/zhl/桌面/200807021528053658.csv", Destination:= _        Range("A1"))        .Name = "200807021528053658_1"        .FieldNames = True        .RowNumbers = False        .FillAdjacentFormulas = False        .PreserveFormatting = True        .RefreshOnFileOpen = False        .RefreshStyle = xlInsertDeleteCells        .SavePassword = False        .SaveData = True        .AdjustColumnWidth = True        .RefreshPeriod = 0        .TextFilePromptOnRefresh = False        .TextFilePlatform = 936        .TextFileStartRow = 1        .TextFileParseType = xlDelimited        .TextFileTextQualifier = xlTextQualifierDoubleQuote        .TextFileConsecutiveDelimiter = False        .TextFileTabDelimiter = False        .TextFileSemicolonDelimiter = False        .TextFileCommaDelimiter = True        .TextFileSpaceDelimiter = False        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _        2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)        .TextFileTrailingMinusNumbers = True        .Refresh BackgroundQuery:=False    End WithEnd Sub然后根据上面的宏写了如下的delphi代码:
        xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);        //xlQuery.Name := '';        xlQuery.FieldNames := True;        xlQuery.RowNumbers := False;        xlQuery.FillAdjacentFormulas := False;        xlQuery.PreserveFormatting := True;        xlQuery.RefreshOnFileOpen := False;        //xlQuery.RefreshStyle := 'xlInsertDeleteCells';        xlQuery.SavePassword := False;        xlQuery.SaveData := True;        xlQuery.AdjustColumnWidth := True;        xlQuery.RefreshPeriod := 0;        xlQuery.TextFilePromptOnRefresh := False;        xlQuery.TextFilePlatform := 936;        xlQuery.TextFileStartRow := 1;        //xlQuery.TextFileParseType := 'xlDelimited';        //xlQuery.TextFileTextQualifier := 'xlTextQualifierDoubleQuote';        xlQuery.TextFileConsecutiveDelimiter := False;        xlQuery.TextFileTabDelimiter := False;        xlQuery.TextFileSemicolonDelimiter := False;        xlQuery.TextFileCommaDelimiter := True;        xlQuery.TextFileSpaceDelimiter := False;        xlQuery.TextFileColumnDataTypes := A;        xlQuery.TextFileTrailingMinusNumbers := True;        xlQuery.Refresh;
使用excle的导入功能后转换原来的文件之用了10秒钟。