Страница 1 из 2

Экспорт в Excel из TdxQueryGrid

Добавлено: 05 авг 2019, 14:29
firefinder
Добрый день, коллеги.

Кто-нибудь реализовывал экспорт в Excel из TdxQueryGrid? Если да, то прошу подсказать реализацию, ибо не силён в скриптах. :(

Экспорт в Excel из TdxQueryGrid

Добавлено: 05 авг 2019, 15:32
Develop-Soft
firefinder писал(а):экспорт в Excel из TdxQueryGrid

Конкретно сабж не встречал, надо писать... А чем "Печать" (в ods) не подходит..?

Экспорт в Excel из TdxQueryGrid

Добавлено: 05 авг 2019, 16:56
firefinder
Благодарю за наводку, про шаблон .ods мне и стоило подумать в первую очередь.

Экспорт в Excel из TdxQueryGrid

Добавлено: 05 авг 2019, 18:16
Develop-Soft
Накидал расширяйку (действие кнопки):
Изображение Изображение
Печать запроса.zip
(1.45 КБ) 120 скачиваний

Экспорт в Excel из TdxQueryGrid

Добавлено: 05 авг 2019, 22:56
firefinder
Огромное спасибо! Это именно то, что я искал.

Экспорт в Excel из TdxQueryGrid

Добавлено: 24 мар 2020, 10:02
makcim737
Develop-Soft писал(а):Накидал расширяйку (действие кнопки):
Изображение Изображение
Печать запроса.zip


Хорошее расширение, но у меня почему-то из запроса дополнительно вылезает дублирующаяся снизу строка со скрытыми значениями, которой не должно быть, выделил красным и желтым на скрине, а синим выделил нормальную строку.

Экспорт в Excel из TdxQueryGrid

Добавлено: 24 мар 2020, 10:13
Develop-Soft
Симпатичный скриншот. Но толку от него мало - кишки бы, сердце, почки...

Экспорт в Excel из TdxQueryGrid

Добавлено: 24 мар 2020, 10:32
makcim737
Develop-Soft писал(а):Симпатичный скриншот. Но толку от него мало - кишки бы, сердце, почки...

Скинул файл базы в личку

Экспорт в Excel из TdxQueryGrid

Добавлено: 24 мар 2020, 11:58
Develop-Soft

Код: Выделить всё

{@action
Id=6BE5EB19-B282-4346-B80F-63B1FCBF57AD
Target=button
OrigName=QuerySimplePrint
Name=Печать запроса
Group=Расширение компонентов
UI=
<ui>
<component name="qg" filter="TdxQueryGrid" caption="Запрос для вывода на печать:">
<file name="nm" caption="Имя файла (необязательно):">
</ui>
Description=Печать запроса
@}

function FRewritable(f:string):boolean;
var fileStream:TFileStream;
begin
  try
    fileStream := TFileStream.Create(f, fmOpenWrite);
    result:=true;
  except
    result:=false;
  finally;
    if fileStream<>nil then
    begin
      fileStream.Free;
      fileStream := nil;
    end;
  end;
end;

function AutoNumFileName(FFName:string;WithReplace:boolean):string;
var Path,FileNameNoExt,FileExt,NewName:string;
i:integer;

begin
if FileExists(FFName)=false then
begin
  result:=FFName;
  exit;
end;

Path := ExtractFilePath(FFName);
FileNameNoExt := ExtractFileNameOnly(FFName);
FileExt := ExtractFileExt(FFName);

i := 1;
NewName := FFName;
while FileExists(NewName) do
   if WithReplace then
      begin
        if FRewritable(NewName) then
          begin
            result:=NewName;
            exit;
          end
      else
        begin
          inc(i);
          NewName:=Path+FileNameNoExt+'('+IntToStr(i)+')'+FileExt;
          result:=NewName;
        end;
      end
  else
    begin
      inc(i);
      NewName:=Path+FileNameNoExt+'('+IntToStr(i)+')'+FileExt;
      result:=NewName;
    end;
end;

function AutoDetectStr(Field:TField):string;
begin
  if Field.DataType = ftString then
  result:='str' else
  result:='num'
end;

procedure QuerySimplePrint(QGrid,FileName:string);
var i:integer;
  SL:TStringList;
  F:TField;
  S, FN, Tbl_begin,Tbl_end:string;
  Grid: TdxQueryGrid;
begin
  try
  Grid:=TdxQueryGrid(Self.FindComponent(QGrid));
  if Grid=nil then exit;
  if Trim(FileName)='' then
  FN:=AutoNumFileName(GetTempDir + Grid.QueryName + '.xls',true)
  else FN:=AutoNumFileName(FileName,true);
  Tbl_begin :=
  '<html xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns="http://www.w3.org/TR/REC-html40"> ' +
  '<head> ' +
  '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> ' +
  '<!--[if gte mso 9]><xml> ' +
  ' <x:ExcelWorkbook> ' +
  '  <x:ExcelWorksheets> ' +
  '   <x:ExcelWorksheet> ' +
  '    <x:Name>Лист 1</x:Name> ' +
  '    <x:WorksheetOptions> ' +
  '     <x:Selected/> ' +
  '     <x:Panes> ' +
  '      <x:Pane> ' +
  '       <x:Number>3</x:Number> ' +
  '       <x:ActiveRow>3</x:ActiveRow> ' +
  '      </x:Pane> ' +
  '     </x:Panes> ' +
  '     <x:ProtectContents>False</x:ProtectContents> ' +
  '     <x:ProtectObjects>False</x:ProtectObjects> ' +
  '     <x:ProtectScenarios>False</x:ProtectScenarios> ' +
  '    </x:WorksheetOptions> ' +
  '   </x:ExcelWorksheet> ' +
  '  </x:ExcelWorksheets> ' +
  ' </x:ExcelWorkbook> ' +
  '</xml><![endif]--> ' +
  '</head> ' +
  '<body> ' +
  ' ' +
  '<table style="border-collapse: collapse;" x:str> ' +
  '    <tr> ';
  Tbl_end := '</table>';
  SL:=TStringList.Create;
  SL.Add(Tbl_begin);
  for i:=0 to Grid.Columns.Count-1 do
  begin
   if not (Grid.Columns[i].Visible) then Continue;
    S:=
    '<td x:num width='+IntToStr(Grid.Columns[i].Width)+  // x:num
    ' style="background-color:whitesmoke; border: 1pt solid gray;"><b>'+Grid.Columns[i].Title.Caption+
    '</b></td>';
    SL.Add(S);
  end;
  Grid.DisableControls;
  Grid.DisableScrollEvents;
  Grid.MoveFirst;
  while not Grid.EoF do
  begin
    SL.Add('<tr>');
    S:='';
    for i:=0 to Grid.Columns.Count-1 do
    begin
      if not (Grid.Columns[i].Visible) then Continue;
      F:=Grid.Columns[i].Field;
      if Grid.Recno mod 2 = 0 then S:= '#FDFCFC' else S:='#FFFFFF';
      SL.Add('<td  style="background-color:'+s+'; border: 0.25pt solid gray;" x:'+AutoDetectStr(F)+'>'
      + VarToStr(F.Value) + '</td>');
    end;
    SL.Add('</tr>')
    Grid.MoveNext;
  end;
  SL.Add(Tbl_end);
  Grid.EnableControls;
  Grid.EnableScrollEvents;
  try
  SL.SaveToFile(FN);
  ShellExecute('',FN,'','',10)
  except
  MsgBox('Ошибка сохранения файла:',ExceptionParam);
end;
finally
SL.Free;
end;
end;

Экспорт в Excel из TdxQueryGrid

Добавлено: 24 мар 2020, 14:58
makcim737
Спасибо! Супер, работает! )