func.pas

来自「应对服装行业的生产成本控制系统」· PAS 代码 · 共 594 行 · 第 1/2 页

           c3Data.First;
    for j2 := 0 to c3Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[i+i1+2, j2 + 1] := c3Data.Fields[j2].DisplayLabel;
        ExcelWorksheet1.Cells.item[i+i1+2, j2 + 1].font.size :='10';
      end;
    for i2 := 1 to c3Data.RecordCount do
      begin
        for j2 := 0 to c3Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i+i1++i2+2, j2 + 1] :=
                c3Data.Fields[j2].Asstring;
            ExcelWorksheet1.Cells.item[i+i1+i2+2, j2 + 1].font.size :='10';
          end;
        c3Data.Next;
      end;
      end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size :='14';
    ExcelWorksheet1.SaveAs(filename);
    Application.Messagebox(pchar('数据成功导出' + filename), '数据导出',
      mb_Ok);
  finally
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  end;
  end;
  procedure writetoexcel2(c1data,c2data:tclientdataset;sname,title:string);
var
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  i, j,i1,j1,i2,j2: integer;
  filename: string;
begin
  //filename := concat(extractfilepath(application.exename), sName, '.xls');
  filename:=sName;
  try
    ExcelApplication1 := TExcelApplication.Create(Application);
    ExcelWorksheet1 := TExcelWorksheet.Create(Application);
    ExcelWorkbook1 := TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
  except
    Application.Messagebox('Excel 没有安装!','系统提示您', MB_ICONERROR + mb_Ok);
    Abort;
  end;
  try
    ExcelApplication1.Workbooks.Add(EmptyParam, 0);
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
    c1Data.First;
    for j := 0 to c1Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[3, j + 1] := c1Data.Fields[j].DisplayLabel;
        ExcelWorksheet1.Cells.item[3, j + 1].font.size :='10';
      end;
    for i := 4 to c1Data.RecordCount + 3 do
      begin
        for j := 0 to c1Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i, j + 1] :=
                c1Data.Fields[j].Asstring;
            ExcelWorksheet1.Cells.item[i, j + 1].font.size :='10';
          end;
        c1Data.Next;
      end;
       if c2data.Active then
      begin
        c2Data.First;
    for j1 := 0 to c2Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[i+1, j1 + 1] := c2Data.Fields[j1].DisplayLabel;
        ExcelWorksheet1.Cells.item[i+1, j1 + 1].font.size :='10';
      end;
    for i1 := 1 to c2Data.RecordCount  do
      begin
        for j1 := 0 to c2Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i+i1+1, j1 + 1] :=
                c2Data.Fields[j1].Asstring;
            ExcelWorksheet1.Cells.item[i+i1+1, j1 + 1].font.size :='10';
          end;
        c2Data.Next;
      end;
      end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size :='14';
    ExcelWorksheet1.SaveAs(filename);
    Application.Messagebox(pchar('数据成功导出' + filename), '数据导出',
      mb_Ok);
  finally
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  end;
  end;
  procedure writetoexcela2(c1data,c2data:tadoquery;sname,title:string);
var
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  i, j,i1,j1,i2,j2: integer;
  filename: string;
begin
  //filename := concat(extractfilepath(application.exename), sName, '.xls');
  filename:=sName;
  try
    ExcelApplication1 := TExcelApplication.Create(Application);
    ExcelWorksheet1 := TExcelWorksheet.Create(Application);
    ExcelWorkbook1 := TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
  except
    Application.Messagebox('Excel 没有安装!','系统提示您', MB_ICONERROR + mb_Ok);
    Abort;
  end;
  try
    ExcelApplication1.Workbooks.Add(EmptyParam, 0);
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
    c1Data.First;
    for j := 0 to c1Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[3, j + 1] := c1Data.Fields[j].DisplayLabel;
        ExcelWorksheet1.Cells.item[3, j + 1].font.size :='10';
      end;
    for i := 4 to c1Data.RecordCount + 3 do
      begin
        for j := 0 to c1Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i, j + 1] :=
                c1Data.Fields[j].Asstring;
            ExcelWorksheet1.Cells.item[i, j + 1].font.size :='10';
          end;
        c1Data.Next;
      end;
       if c2data.Active then
      begin
        c2Data.First;
    for j1 := 0 to c2Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[i+1, j1 + 1] := c2Data.Fields[j1].DisplayLabel;
        ExcelWorksheet1.Cells.item[i+1, j1 + 1].font.size :='10';
      end;
    for i1 := 1 to c2Data.RecordCount  do
      begin
        for j1 := 0 to c2Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i+i1+1, j1 + 1] :=
                c2Data.Fields[j1].Asstring;
            ExcelWorksheet1.Cells.item[i+i1+1, j1 + 1].font.size :='10';
          end;
        c2Data.Next;
      end;
      end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size :='14';
    ExcelWorksheet1.SaveAs(filename);
    Application.Messagebox(pchar('数据成功导出' + filename), '数据导出',
      mb_Ok);
  finally
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  end;
  end;
procedure writetoexcel4(c1data,c2data,c3data,c4data:tclientdataset;sname,title:string);
var
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  i, j,i1,j1,i2,j2,i3,j3: integer;
  filename: string;
begin
  //filename := concat(extractfilepath(application.exename), sName, '.xls');
  filename:=sName;
  try
    ExcelApplication1 := TExcelApplication.Create(Application);
    ExcelWorksheet1 := TExcelWorksheet.Create(Application);
    ExcelWorkbook1 := TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
  except
    Application.Messagebox('Excel 没有安装!','系统提示您', MB_ICONERROR + mb_Ok);
    Abort;
  end;
  try
    ExcelApplication1.Workbooks.Add(EmptyParam, 0);
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
    c1Data.First;
    for j := 0 to c1Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[3, j + 1] := c1Data.Fields[j].DisplayLabel;
        ExcelWorksheet1.Cells.item[3, j + 1].font.size :='10';
      end;
    for i := 4 to c1Data.RecordCount + 3 do
      begin
        for j := 0 to c1Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i, j + 1] :=
                c1Data.Fields[j].Asstring;
            ExcelWorksheet1.Cells.item[i, j + 1].font.size :='10';
          end;
        c1Data.Next;
      end;
       if c2data.Active then
      begin
        c2Data.First;
    for j1 := 0 to c2Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[i+1, j1 + 1] := c2Data.Fields[j1].DisplayLabel;
        ExcelWorksheet1.Cells.item[i+1, j1 + 1].font.size :='10';
      end;
    for i1 := 1 to c2Data.RecordCount  do
      begin
        for j1 := 0 to c2Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i+i1+1, j1 + 1] :=
                c2Data.Fields[j1].Asstring;
            ExcelWorksheet1.Cells.item[i+i1+1, j1 + 1].font.size :='10';
          end;
        c2Data.Next;
      end;
      end;
      if c3data.Active then
      begin
           c3Data.First;
    for j2 := 0 to c3Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[i+i1+2, j2 + 1] := c3Data.Fields[j2].DisplayLabel;
        ExcelWorksheet1.Cells.item[i+i1+2, j2 + 1].font.size :='10';
      end;
    for i2 := 1 to c3Data.RecordCount do
      begin
        for j2 := 0 to c3Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i+i1+i2+2, j2 + 1] :=
                c3Data.Fields[j2].Asstring;
            ExcelWorksheet1.Cells.item[i+i1+i2+2, j2 + 1].font.size :='10';
          end;
        c3Data.Next;
      end;
      end;
    if c4data.Active then
      begin
           c4Data.First;
    for j3 := 0 to c4Data.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[i+i1+i2+2, j3 + 1] := c4Data.Fields[j3].DisplayLabel;
        ExcelWorksheet1.Cells.item[i+i1+i2+2, j3 + 1].font.size :='10';
      end;
    for i3 := 1 to c4Data.RecordCount do
      begin
        for j3 := 0 to c4Data.Fields.Count - 1 do
          begin
          ExcelWorksheet1.Cells.item[i, j + 1].numberformatlocal:='@';
            ExcelWorksheet1.Cells.item[i+i1++i2+i3+2, j2 + 1] :=
                c4Data.Fields[j2].Asstring;
            ExcelWorksheet1.Cells.item[i+i1+i2+i3+2, j2 + 1].font.size :='10';
          end;
        c4Data.Next;
      end;
      end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size :='14';
    ExcelWorksheet1.SaveAs(filename);
    Application.Messagebox(pchar('数据成功导出' + filename), '数据导出',
      mb_Ok);
  finally
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  end;
  end;

end.