delphi控制Excel（二）

/ XL Report
unit LebutXLReport;
interface
uses
  Controls, xlReport, cxGrid, cxStyles, Dialogs, cxExportGrid4Link, ShellAPI,
  cxGridCustomTableView, LebutCommons, cxGridCustomView, DB, Classes, kbmMemTable,
  cxGridDBTableView, ComObj, cxCustomData, cxGridDBBandedTableView, cxGridDBCardView,
  cxGridTableView;
{*
  导出成 Excel
  @param AControls 在导出操作时不能进行任何操作的控件列表，如导出按钮、查询按钮
  @param AReport Excel 报表控件
}
procedure ReportToExcel(AControls: array of TControl; AReport: TxlReport); overload;
{*
  导出文件
  @param AGrid 要导出的网格
  @param AStye 修改网格的字体和颜色 默认为空
  @param AFileName 导出文件的路径和文件名 默认为空(应用程序所在路径)
  @param ADynamic 是否动态获得文件名 True 是 False 不是 默认为False
}
procedure ReportToExcel(AGrid: TcxGrid; AStye: TcxStyle = nil; AFileName: string = ''; ADynamic: Boolean = False); overload;


{*
  网格 完全展现到Excel中去
  暂时只支持 TcxGridDBTableView ，TcxGridDBBandedTableView类型网格
  @param AcxGridDBTableView 需要展现的网格
  @param ASheetName Excel的Sheet的命名[既要展示的有关什么的信息]
}
procedure ReportToExcel(AcxGridDBTableView: TcxCustomGridView; ASheetName: string); overload;
implementation
uses
  FormProgress, Forms, xlEngine, Windows, SysUtils;


procedure ReportToExcel(AControls: array of TControl; AReport: TxlReport);
var
  VProgressForm: TProgressForm;
  VIndex: Integer;
  VActive: Boolean;
begin
  VActive := False;


  Screen.Cursor := crHourGlass;
  try
    with AReport.DataSources do
    begin
      for VIndex := 0 to Count - 1 do
      begin
        Items[VIndex].Enabled := Items[VIndex].DataSet.Active;


        if Items[VIndex].Enabled then
          VActive := True;
      end;
    end;


    if VActive then
    begin
      for VIndex := 0 to Length(AControls) - 1 do
        AControls[VIndex].Enabled := False;


      VProgressForm := TProgressForm.Create(nil);
      try
        VProgressForm.SetProgressCaption('正在导出成 Excel，请稍等...');
        VProgressForm.Show;
        Application.ProcessMessages;
        try
          AReport.Report();
        except
          on erErr: ExlReportError do
            if erErr.Message = 'MS Excel not installed' then
              Application.MessageBox('您的系统没有安装 Excel，不能进行导出操作，请先安装 Excel！', '导出异常', MB_OK + MB_ICONERROR)
            else
              Application.MessageBox(PChar(erErr.Message), '导出异常', MB_OK + MB_ICONERROR);
        end;
      finally
        FreeAndNil(VProgressForm);


        for VIndex := 0 to Length(AControls) - 1 do
          AControls[VIndex].Enabled := True;
      end;
    end
    else
    begin
      MessageBox(0,'必须有数据才能进行导出,请先进行点击查询按钮进行查询','导出提示',MB_OK + MB_ICONINFORMATION);
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;


procedure ReportToExcel(AGrid: TcxGrid; AStye: TcxStyle = nil; AFileName: string = ''; ADynamic: Boolean = False);
var
  VFileName: string;
  VIndex: Integer;
  VStyle: array of TcxStyle;
  VExt: string;
begin
  if ADynamic then
    with TSaveDialog.Create(nil) do
      try
        DefaultExt := 'xls';
        if Execute then
          VFileName := FileName
        else
          Exit;
      finally
        Free;
      end
  else if AFileName = '' then
    VFileName := ChangeFileExt(AppExeName, '.xls')
  else
    VFileName := AFileName;


  if AStye <> nil then
  begin
    SetLength(VStyle, AGrid.Levels.Count);
    for VIndex := 0 to AGrid.Levels.Count - 1 do
      if AGrid.Levels[VIndex].GridView is TcxCustomGridTableView then
        with (AGrid.Levels[VIndex].GridView as TcxCustomGridTableView).Styles do
        begin
          VStyle[VIndex] := Content;
          Content := AStye;
        end;
  end;
  try
    try
      VExt := ExtractFileExt(VFileName);


      if VExt = '.txt' then
        ExportGrid4ToTEXT(VFileName, AGrid, True, True)
      else if VExt = '.xml' then
        ExportGrid4ToXML(VFileName, AGrid, True, True)
      else if VExt = '.html' then
        ExportGrid4ToHTML(VFileName, AGrid, True, True)
      else if VExt = '.xls' then
        ExportGrid4ToExcel(VFileName, AGrid, True, True);
    except
      Application.MessageBox('导出不成功，可能是导出文件正处于打开状态或其他原因！', '提示', MB_OK + MB_ICONERROR);
      Exit;
    end;


    ShellExecuteFile(VFileName);
  finally
    if AStye <> nil then
      for VIndex := 0 to AGrid.Levels.Count - 1 do
        if AGrid.Levels[VIndex].GridView is TcxCustomGridTableView then
          (AGrid.Levels[VIndex].GridView as TcxCustomGridTableView).Styles.Content := VStyle[VIndex];
  end;
end;


procedure ReportToExcel(AcxGridDBTableView: TcxCustomGridView; ASheetName: string); overload;
var
  VExcelApp: Variant;
  i, j, m, VIndex, VPosition, VPosition2, VInteger, VUnite: Integer;
  VDataSet: TDataSet;
  VArrayList: TStrings;
  VString, VStringResult, VFilter, VFieldName, Vlist, VBandCaption, VBandCaptionNext: string;
  VFieldType: TFieldType;
  VProgressForm: TProgressForm;
  VkbmMemTableCompareOptions: TkbmMemTableCompareOptions;
  VBookMark: Pointer;
  VFloat: Double;


  // 获取网格类型 1：TcxGridDBTableView 2：TcxGridDBBandedTableView 其余的3
  function GetGridType: Integer;
  begin
    if AcxGridDBTableView.ClassType = TcxGridDBTableView then
      Result := 1
    else if AcxGridDBTableView.ClassType = TcxGridDBBandedTableView then
      Result := 2
    else
      Result := 3;
  end;


  // 获取数据集
  function GetDataSet: TDataSet;
  begin
    Result := nil;
    case GetGridType of
      1: Result := (AcxGridDBTableView as TcxGridDBTableView).DataController.DataSource.DataSet;
      2: Result := (AcxGridDBTableView as TcxGridDBBandedTableView).DataController.DataSource.DataSet;
    end;
  end;


  // 网格断开
  procedure GridCut;
  begin
    VBookMark := VDataSet.GetBookmark;
    AcxGridDBTableView.BeginUpdate;
    case GetGridType of
      1: (AcxGridDBTableView as TcxGridDBTableView).DataController.DataSource.DataSet := nil;
      2: (AcxGridDBTableView as TcxGridDBBandedTableView).DataController.DataSource.DataSet := nil;
    end;
  end;


  // 网格连接上
  procedure GridConnect;
  begin
    VDataSet.GotoBookmark(VBookMark);
    case GetGridType of
      1: (AcxGridDBTableView as TcxGridDBTableView).DataController.DataSource.DataSet := VDataSet;
      2: (AcxGridDBTableView as TcxGridDBBandedTableView).DataController.DataSource.DataSet := VDataSet;
    end;
    AcxGridDBTableView.EndUpdate;
  end;


  // 获取列数
  function GetColumnCount: Integer;
  begin
    Result := 0;
    case GetGridType of
      1: Result := (AcxGridDBTableView as TcxGridDBTableView).ColumnCount;
      2: Result := (AcxGridDBTableView as TcxGridDBBandedTableView).ColumnCount;
    end;
  end;


  // 获取某一列 AInteger: 哪一列
  function GetColumn(AInteger: Integer): TcxGridColumn;
  begin
    Result := nil;
    case GetGridType of
      1: Result := (AcxGridDBTableView as TcxGridDBTableView).Columns[AInteger] as TcxGridColumn;
      2: Result := (AcxGridDBTableView as TcxGridDBBandedTableView).Columns[AInteger] as TcxGridColumn;
    end;
  end;


  //获取一共排序的列数
  function GetSortedItemCount: Integer;
  begin
    Result := 0;
    case GetGridType of
      1: Result := (AcxGridDBTableView as TcxGridDBTableView).SortedItemCount;
      2: Result := (AcxGridDBTableView as TcxGridDBBandedTableView).SortedItemCount;
    end;
  end;


  //获取一排序绑定的字段 AInteger: 哪一列
  function GetFieldName(AInteger: Integer): string;
  begin
    Result := '';
    case GetGridType of
      1: Result := (AcxGridDBTableView as TcxGridDBTableView).Columns[AInteger].DataBinding.FieldName;
      2: Result := (AcxGridDBTableView as TcxGridDBBandedTableView).Columns[AInteger].DataBinding.FieldName;
    end;
  end;


  // 获取过滤条件
  function GetFilterText: string;
  begin
    Result := '';
    case GetGridType of
      1: Result := (AcxGridDBTableView as TcxGridDBTableView).DataController.Filter.FilterText;
      2: Result := (AcxGridDBTableView as TcxGridDBBandedTableView).DataController.Filter.FilterText;
    end;
  end;
begin
  if GetGridType = 3 then
  begin
    Application.MessageBox(PChar(Format('暂时还不支持该“%s”类型网格导出！', [AcxGridDBTableView.ClassName])), '提示', MB_OK + MB_ICONERROR);
    Exit;
  end;


  VProgressForm := TProgressForm.Create(nil);
  try
    VProgressForm.SetProgressCaption('正在导出成 Excel，请稍等...');
    VProgressForm.Show;
    Application.ProcessMessages;


    try
      VExcelApp := CreateOleObject('Excel.Application');
    except
      on E: Exception do
      begin
        Application.MessageBox(PChar(E.Message), '提示', MB_ICONERROR);
        Exit;
      end;
    end;


    VExcelApp.Visible := False;
    VExcelApp.Caption := Format('Microsoft Excel %s', [ASheetName]);


    VInteger := VExcelApp.SheetsInNewWorkbook;
    try
      VExcelApp.SheetsInNewWorkbook := 1;
      VExcelApp.WorkBooks.Add();
      VExcelApp.WorkSheets[1].Name := ASheetName;
    finally
      VExcelApp.SheetsInNewWorkbook := VInteger;
    end;


    // 获取数据集
    VDataSet := GetDataSet;


    try
      // 网格断开
      GridCut;


      // 进行排序
      for i := 0 to GetColumnCount - 1 do
        with GetColumn(i) do
          if SortIndex = GetSortedItemCount - 1 then
            if SortOrder = soAscending then
            begin
              (VDataSet as TkbmMemTable).SortOn(GetFieldName(i), []);
              Break;
            end
            else if SortOrder = soDescending then
            begin
              VkbmMemTableCompareOptions := [mtcoDescending];
              (VDataSet as TkbmMemTable).SortOn(GetFieldName(i), VkbmMemTableCompareOptions);
              Break;
            end;


      // 数据进入
      VIndex := 0;
      VUnite := 1;
      VBandCaption := '';
      VBandCaptionNext := '';


      for i := 0 to GetColumnCount - 1 do
        with GetColumn(i) do
          if Visible then
          begin
            Inc(VIndex);
            j := GetGridType + 1;


            VFieldName := GetFieldName(i);


            // 设置列宽
            if Width < 2168 then
              VExcelApp.Columns[VIndex].ColumnWidth := Width/8.0
            else
              VExcelApp.Columns[VIndex].ColumnWidth := 255;


            if GetGridType = 2 then
            begin
              VBandCaptionNext := (AcxGridDBTableView as TcxGridDBBandedTableView).Columns[i].Position.Band.Caption;


              if VIndex = 1 then
              begin
                VBandCaption := VBandCaptionNext;
                VExcelApp.Cells[1, 1].Value := VBandCaptionNext;
              end
              else if i = GetColumnCount - 1 then
              begin
                if VBandCaptionNext = VBandCaption then
                begin
                  VExcelApp.ActiveSheet.Range[VExcelApp.Cells[1, VUnite], VExcelApp.Cells[1, VIndex]].Select;
                  VExcelApp.Selection.Merge;
                end
                else
                  VExcelApp.Cells[1, VIndex].Value := VBandCaptionNext;
              end
              else
              begin
                if VBandCaptionNext <> VBandCaption then
                begin
                  VExcelApp.ActiveSheet.Range[VExcelApp.Cells[1, VUnite], VExcelApp.Cells[1, VIndex - 1]].Select;
                  VExcelApp.Selection.Merge;
                  VUnite := VIndex;
                  VExcelApp.Cells[1, VIndex].Value := VBandCaptionNext;
                  VBandCaption := VBandCaptionNext;
                end;
              end;
            end;


            VExcelApp.Cells[GetGridType, VIndex].Value := Caption;


            case VDataSet.FindField(VFieldName).DataType of
              ftDateTime: begin
                            with VDataSet do
                            begin
                              First;
                              while not Eof do
                              begin
                                VFloat := FieldByName(VFieldName).AsFloat;
                                if FieldByName(VFieldName).AsString <> '' then
                                  if VFloat <= 1 then
                                  begin
                                    VExcelApp.Columns[VIndex].NumberFormatLocal := 'hh:mm:ss';
                                    Break;
                                  end
                                  else if VFloat > Trunc(VFloat) then
                                  begin
                                    VExcelApp.Columns[VIndex].NumberFormatLocal := 'yyyy-mm-dd hh:mm:ss';
                                    Break;
                                  end
                                  else if VFloat = Trunc(VFloat) then
                                  begin
                                    VExcelApp.Columns[VIndex].NumberFormatLocal := 'yyyy-mm-dd';
                                    Break;
                                  end;
                                Next;
                              end;
                            end;
                          end;
              ftString: VExcelApp.Columns[VIndex].NumberFormatLocal := '@';
            end;


            with VDataSet do
            begin
              First;
              while not Eof do
              begin
                VExcelApp.Cells[j, VIndex].Value := FieldByName(VFieldName).AsString;


                Next;
                Inc(j);
              end;
            end;
          end;


      // 字体设置为 9 号
      VExcelApp.Cells.Select;
      VExcelApp.Selection.Font.Name := '宋体';
      VExcelApp.Selection.Font.Size := 9;


      // 自动换行
      VExcelApp.Selection.WrapText := True;
      VExcelApp.Selection.VerticalAlignment := '1';


      //冻结窗格
      VExcelApp.Rows[GetGridType + 1].Select;
      VExcelApp.ActiveWindow.FreezePanes := True;


      // 过滤
      VExcelApp.Cells[GetGridType, 1].AutoFilter;


      // 取得过滤条件
      VFilter := GetFilterText;


      // 开始过滤
      if VFilter <> '' then
      begin
        // 去掉前'(',后')'
        VFilter := Copy(VFilter, 2, Length(VFilter) - 2);


        //,替换') AND ('
        VFilter := StringReplace(VFilter, ') AND (', ',', [rfReplaceAll]);


        // 分离到数组
        VArrayList := Split2List(VFilter, ',');
        try
          for m := 0 to VArrayList.Count - 1 do
          begin
            Vlist := VArrayList[m];
            // 获取 ' = ' 的位置
            VPosition := Pos(' = ', Vlist);


            // 取过滤条件
            if VPosition <> 0 then
            begin
              VString := LowerCase(Copy(Vlist, 1, VPosition - 1));
              VStringResult := Copy(Vlist, VPosition + 3, Length(Vlist) - VPosition - 2);


              VIndex := 0;
              for i := 0 to GetColumnCount - 1 do
                with GetColumn(i) do
                  if Visible then
                  begin
                    Inc(VIndex);


                    VFieldName := GetFieldName(i);
                    VFieldType := VDataSet.FindField(VFieldName).DataType;


                    if LowerCase(VFieldName) = VString then
                    begin
                      if VFieldType = ftFloat then
                        VExcelApp.Selection.AutoFilter(VIndex, VStringResult)
                      else if VStringResult = 'NULL' then
                        VExcelApp.Selection.AutoFilter(VIndex, '=')
                      else
                        VExcelApp.Selection.AutoFilter(VIndex, Copy(VStringResult, 2, Length(VStringResult) - 2));


                      Break;
                    end;
                  end;
            end
            else
            begin
              VPosition2 := Pos(' <> ', Vlist);
              VString := LowerCase(Copy(Vlist, 1, VPosition2 - 1));


              VIndex := 0;


              for i := 0 to GetColumnCount - 1 do
                with GetColumn(i) do
                  if Visible then
                  begin
                    Inc(VIndex);


                    VFieldName := GetFieldName(i);


                    if LowerCase(VFieldName) = VString then
                    begin
                      VExcelApp.Selection.AutoFilter(VIndex, '<>');
                      Break;
                    end;
                  end;
            end;
          end;
        finally
          FreeAndNil(VArrayList);
        end;
      end;


      case GetGridType of
        1: begin
             // 居中
             VExcelApp.Rows[1].Select;
             VExcelApp.Selection.HorizontalAlignment := '3';//xlCenter 1--常规、2--靠左、3--居中、4--靠右
             //光标跑上去
             VExcelApp.Cells[2, 1].Select;
           end;
        2: begin
             // 居中
             VExcelApp.Rows[1].Select;
             VExcelApp.Selection.HorizontalAlignment := '3';//xlCenter 1--常规、2--靠左、3--居中、4--靠右
             VExcelApp.Rows[2].Select;
             VExcelApp.Selection.HorizontalAlignment := '3';//xlCenter 1--常规、2--靠左、3--居中、4--靠右
             //光标跑上去
             VExcelApp.Cells[3, 1].Select;
           end;
      end;
    finally
      // 网格连接上
      GridConnect;
    end;


    // 显示
    VExcelApp.Visible := True;
  finally
    FreeAndNil(VProgressForm);
  end;
end;


end.