作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

////////////////////////////////    Excel 的一个宏  ///////////////////////////////////
Sub setpageinfo(ByVal regDateStr As String)

    Dim I, maxRow As Integer
   
    '取得最大行 maxRow
    Range("A1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    maxRow = ActiveCell.Row
   
    '取得有日期的行
    I = maxRow
    Range("A1").Select
    While (Range("A" & CStr(I)).Value <> "dateLine") And (I >= 1)
      'If Range("A" & CStr(I)).Value = "change1" Then
      '  Rows(CStr(I) & ":" & CStr(I)).RowHeight = 21
      'End If
      I = I - 1
    Wend
    '写入日期
    Range("G" & CStr(I)).Select
    ActiveCell.FormulaR1C1 = buyDateStr
   
    '删除 A 列
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
 
End Sub

////////////////////////////////    Delphi   ///////////////////////////////////
uses comobj,excel97;

function ToExcelReport(dxSourceList: TdxTreeList):boolean;
var XLApp,workbook,sheet:Variant; I_Row,I_Father,I_Child,I,J:integer;
begin
   result:=true;
   try
   if not VarIsEmpty(XLApp) then begin
      XLApp.displayAlerts:=false;
      XLApp.quit;
   end;

  
（1） {---  打开 Excel 文件 ----}
   XLApp:=createOleObject('Excel.Application');  
   XLApp.WorkBooks.Add(A_FileName);  //A_FileName：一个已存在的文件
   workbook := XLApp.workbooks[1];
   sheet:=workbook.worksheets[1];
    XLApp.displayAlerts:=false;
    XLApp.ScreenUpdating:=true;
（2） {---  创建新 Excel 文件 ----}
   XLApp:=createOleObject('Excel.Application');

   //XLApp.visible:=true;
   XLApp.WorkBooks.Add(xlWBatWorkSheet);    // new workSheet
   XLApp.WorkBooks[1].worksheets[1].name:='NewWorkSheet';
   workbook := XLApp.workbooks[1];
   sheet:=workbook.worksheets[1];
    XLApp.displayAlerts:=false;
    XLApp.ScreenUpdating:=true;

   I_Father:=dxSourceList.Count ; I_Row:=1;
   for I:=0 to I_Father-1 do begin
      I_Child:=dxSourceList.items[I].Count ;
      sheet.cells[I_Row,1]:=dxSourceList.items[I].strings[0];
      I_Row:=I_Row+1;
      for J:=0 to I_Child-1 do begin
         sheet.cells[I_Row,1]:=dxSourceList.items[I].items[J].strings[0];
         I_Row:=I_Row+1;
      end;
   end;
  
    //运行宏
    //XLApp.run('macroName',params...)
    //workbook.save ;
    workBook.SaveAs(AFileName,xlNormal,'','',False,False);
   XLApp.visible:=true;
   except
      result:=false;
   end;
end;

procedure Tform1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   if not VarIsEmpty(XLApp) then begin
      XLApp.displayAlerts:=false;
      XLApp.quit;
   end;
end;

相关软件：