Проблема выгрузки из ExpressQuantumGrid 3.2.2 в EXCEL

[fsasha]

Да, переписал через TSpreadSheet. Работает в принципе нормально. Хотя раньше пользовался экспортом через OLE, сейчас пришлось здорово извращаться чтобы переписать макрос, который динамически внедрялся в Excel и использовал рекурсию. От OLE пришлось отказаться поскольку новые версии офиса начинают мудрить с секьюрити и перестает работать то, что работало годами.

 

[ser4270]

Для всех кто хочет использовать встроенный от DevX механизм или сделать свой:

procedure TcxGridDBTableView.CopyToExcel;
var
   ExcelApp: OleVariant;
   col,row:Integer;
   mem: TMemo;
   sline: String;
   Unknown: IUnknown;
   Res: HResult;
   str, WA: string;
   DD: TDateTime;
begin

//  ExportGridToXLSX('C:\RTE\FileName', TcxGrid(TcxGridLevel(Self.Level).Control), True, True, True, 'xlsx', nil);

//  AGrid: TcxGrid; AExpand: Boolean = True; ASaveAll: Boolean = True;
//  AUseNativeFormat: Boolean = True; const AFileExt: string = 'xlsx'; AHandler: TObject = nil);

//exit;

  WA:='Excel.Application';
  Screen.Cursor := -11; //crHourglass;
  DataController.DataSource.DataSet.DisableControls;
  //rte bm := DataController.DataSource.DataSet.GetBookmark;

  try
  if cxCopyExcel then
  begin
    try
      DataController.DataSource.DataSet.First;
      Res := GetActiveObject(ProgIDToClassID(WA), nil, Unknown);
      if Res = MK_E_UNAVAILABLE then
        ExcelApp := CreateOleObject(WA) else
          ExcelApp := GetActiveOleObject(WA);

      ExcelApp.WorkBooks.Add(-4167); //  $FFFFEFB9{xlWBatWorkSheet});
      ExcelApp.ActiveWorkBook.WorkSheets[1].Name := 'Отчет';
    except
      Windows.MessageBox(0, PChar('Операция инициализации вставки в новый лист Excel завершена некорректно.'),
        PChar('Сообщение'), 0);
    end;
  end else // вставка в текущее окно
  begin
    try
      DataController.DataSource.DataSet.First;
      try
        Res := GetActiveObject(ProgIDToClassID(WA),nil,Unknown);
      except
        Windows.MessageBox(0, PChar('GetActiveObject(ProgIDToClassID(WA),nil,Unknown);.'), PChar('SOS'), 0);
      end;

      if Res = MK_E_UNAVAILABLE then
      begin
        try
          ExcelApp := CreateOleObject(WA);
        except
          Windows.MessageBox(0, PChar('CreateOleObject(WA);'), PChar('SOS'), 0);
        end;
        try
          ExcelApp.WorkBooks.Add(-4167); //  $FFFFEFB9{xlWBatWorkSheet});
        except
          Windows.MessageBox(0, PChar('ExcelApp.WorkBooks.Add(4167);'), PChar('SOS'), 0);
        end;
      end else
      try
        ExcelApp := GetActiveOleObject(WA);
      except
        Windows.MessageBox(0, PChar('GetActiveOleObject(WA);'), PChar('SOS'), 0);
      end;
    except
      Windows.MessageBox(0, PChar('Операция вставка в текущий лист Excel завершена некорректно на этапе инициализации.'),
        PChar('Сообщение'), 0);
    end;
  end;

  try
    mem := TMemo.Create(Self);
    mem.Visible := false;
    mem.Parent := Self.Control; //// ???
    mem.Clear;

    sline := '';
    for col := 0 to ColumnCount - 1 do
    if Columns[col].Visible then
    begin
      if Columns[col].Caption <> '' then
      sline := sline + Columns[col].Caption + #9
        else
      begin
        if Columns[col].AlternateCaption <> '' then
        sline := sline + Columns[col].AlternateCaption + #9  else
              sline := sline + Columns[col].Caption + #9
      end;
    end;
    mem.Lines.Add(sline);

    for row := 0 to ViewData.RowCount - 1 do
    begin
      if ViewData.Rows[row].IsData then
      begin
        sline := '';
        for col := 0 to columncount - 1 do
        if columns[col].visible then
        begin
          str := vartostr(viewdata.rows[row].values[col]);
          if (columns[col].databinding.valuetype = 'string') or
            (columns[col].databinding.valuetype = 'widestring') then
          begin
            if (length(str) < 9) and (length(str) > 2)   then
            begin
              try
                // чтобы бороться с автоматическим преобразованием в дату excel
                if trystrtodate(str, dd)
                   then str := str + #$b7;

                if (str[3] in ['.', '\', '-', '/'] )  or
                   ((str[3] in ['.', '\', '-', '/'] ) and (str[6] in ['.', '\', '-', '/']))
                   then str := str + #$b7;
              except
              end;
            end;
            // замена переноса строк на пробелы
            str := cxchangestrn(str, #$a, ' ');
            str := cxchangestrn(str, #$d, ' ');
          end;

          sline := sline + str + #9;
        end;
      end else
      sline := VarToStr(ViewData.Rows[row].Values[0]);

      mem.Lines.Add(sline);
    end;

    mem.SelectAll;
    mem.CopyToClipboard;
    if cxCopyExcel then
      ExcelApp.ActiveWorkBook.WorkSheets['Отчет'].Paste
    else
      ExcelApp.ActiveWorkBook.ActiveSheet.Paste;
    ExcelApp.Visible := true;

   except
    Windows.MessageBox(0, PChar('Копирование данных завершилось фатальной ошибкой.'),
      PChar('Сообщение'), 0);
   end;
  finally
    Screen.Cursor := 0;
    DataController.DataSource.DataSet.EnableControls;
  end;
end;

Примечание:
1. Механизм встроен в контекстное меню cxGrid
2. Переменная cxCopyExcel определяет - Встаdлять данные в новый документ, или в открытый в настоящий момент в Excel
3. Команда ExcelApp.WorkBooks.Add(-4167); // $FFFFEFB9 // xlWBatWorkSheet за последние 20 лет имела разный аргумент с разными версиями MSO