⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 利用delphi
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExcelXP, Excel97,Comctrls,OleCtnrs,ComObj,
  OleServer;


type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    BitBtn3: TBitBtn;
    SaveDialog1: TSaveDialog;
    Edit3: TEdit;
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelWorkbook1: TExcelWorkbook;
    Label1: TLabel;
    Edit2: TEdit;
    Edit4: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
   XlsApp,XlsSheet,XlsWBk : Variant;
  end;

var
  Form1: TForm1;
  times:integer;
  total:integer;
  xushu:array of integer;
  l_time,l_date: TDateTime;
implementation
//var

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
begin
  total:=0;
  total:=strtoint(edit1.Text);
  setlength(xushu,total);
  l_time:=time;
  label1.Caption:=timetostr(l_time);
   for i:= 0 to total - 1 do
     xushu[i]:=i;
  BitBtn1.Enabled:=false;
end;

procedure TForm1.BitBtn3Click(Sender:TObject);
var
 i,j: integer;
 sname,filename: string;
 wavel,pow:string;
begin
 l_date:=date;
 wavel:=edit4.Text;
 pow:=edit2.Text;
 if (wavel='') or (pow='') then
 begin
 showmessage('请输入工作波长和功率!');
 exit;
 end
 else
 begin
 if SaveDialog1.Execute then
  begin
   SName:=SaveDialog1.FileName;
   //filename:=concat(wavel,pow,sName,'.xls');  DateTimeToFileDate
   Filename:=ExtractFilePath(SName)+datetostr(l_date)+'_'+wavel+'_'+ pow+'_'+ExtractFilename(SName)+'.xls';
   if   FileExists(filename)   then
    begin
     if  Application.MessageBox('该文件已经存在,是否覆盖?','确认',MB_ICONQUESTION+MB_YESNO)=IDYES
     then  DeleteFile(FileName);
    end;
   if VarIsEmpty(XlsApp) then
    XlsApp := CreateOleObject('Excel.Application');
   XLsApp.Workbooks.Add;
   XlsSheet:= XLsApp.Worksheets['Sheet1'];
   for j:=1 to 6 do
    begin
     for i:= 0 to total - 1 do
     XlsSheet.Cells[i+1,j] :=xushu[i];
     sleep(1000);
     BitBtn1.Click;
    end;
   XlsSheet.Columns.AutoFit;
   XlsSheet.SaveAs(filename);
  end;
 XlsApp.Visible := true;
 XlsApp.Cells.Select;//Select All Cells
 XlsApp.Selection.Locked := True;// Lock Selected Cells
 end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not VarIsEmpty(XlsApp) then
begin
XlsApp.DisplayAlerts := True; // 7Discard unsaved files....
try 
XlsApp.Application.Quit;
except 
end; 
end; 
end; 


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -