Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Базы данных
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 14.05.2010, 09:25
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию Передача данных в Excel

Этот вопрос очень часто задают на форуме. Я решил не жадничать и поделиться небольшой своей наработкой. Т.к. много писать я не люблю смотрите код:
Код:
unit ExportToExcel;
{
  Модуль для передачи данных в Excel из любого наследника TDataSet

  (c) Aristarh Dark (2010)
  e-mail: aristarh.dark@gmail.com

  Зависимости:
  DB, SysUtils, ComObj, Variants, Math;

  Небольшое описание:
  ds              - набор данных по которому надо построить таблицу в эксель
  TableName       - выводимый заголовок таблицы
  Names           - вариантрый массив имен столбцов, имена должны следовать в том же
                    порядке, что и выводимые поля в наборе данных
  NotOut          - вариантный массив имен полей набора данных которые выводить не
                    следует, поля в массиве следовали в том же порядке что и в наборе
  isDeletePresent - это моя собственная примочка, т.к. в любой таблице я использую
                    поле isDeleted (признак удаленной записи), то такие записи я
                    хотел бы видеть и в результирующей таблице в Excel. В моем
                    варианте они выделяются курсивом.

  Модуль свободен для использования и изменения, ссылка на автора желательна

  Тестировалось на Excel 2003
}
interface
uses
  DB;

procedure ToExcel(ds:TDataSet;TableName:String;Names,NotOut:Variant;isDeletePresent:boolean = True);

implementation
uses
  SysUtils, ComObj, Variants, Math;

const
  TitleRow          = '2';
  TitleCol          = 'B';
  TitleFontName     = 'Times New Roman';
  TitleFontSize     = 12;

  TableHeadRow      = '4';
  TableHeadStartCol = 'B';
  TableHeadFontName = 'Courier New';
  TableHeadFontSize = 12;

  TableDataStartRow = '5';
  TableDataStartCol = 'B';
  TableDataFontName = 'Courier New';
  TableDataFontSize = 12;

function ExInc(value:string;delta:integer = 1;trend:boolean = true):string;
{
   Сложение/вычитание координат Excel
   value - значение (буквенная координата столбца)
   delta - коэффициент приращения [1]
   trend - направление приращения .t. - сложение, .f. - вычитание [.t.]

   ВНИМАНИЕ!!
   работает только до 'ZZ'
}
var
  numeric:integer;
  low,hig:integer;
begin
  if not(trend) then
    delta:=delta*(-1);
  //распаковка
  if Length(value)>1 then
     numeric:=(ord(value[1])-64)*26+(ord(value[2])-64)
  else
     numeric:=ord(value[1])-64;
  numeric:=numeric+delta;
  //упаковка
  if numeric>26 then
    begin
      low:=numeric-(26*Trunc(numeric/26));
      hig:=Trunc(numeric/26);
      if low=0 then
        begin
          low:=26;
          hig:=hig-1;
        end;
      result:=chr(hig+64)+chr(low+64);
    end
  else
     result:=chr(64+numeric);
end;


function CheckField(FieldName:string;Data:Variant):boolean;
var
  i:integer;
begin
  Result:=True;
  for i:=VarArrayLowBound(data,1) to VarArrayHighBound(data,1) do
    if AnsiUpperCase(FieldName)=AnsiUpperCase(data[i]) then
      Result:=False;
end;
procedure ToExcel(ds:TDataSet;TableName:String;Names,NotOut:Variant;isDeletePresent:boolean = True);
var
  Excel:OleVariant;
  Sheet:OleVariant;
  Data:Variant;
  i,j:integer;
  counter:integer;
  NoOutFieldsPresent:boolean;
  NoOutCounter:integer;
  NoOutCounterNeedInc:boolean;
  TableWidth:integer;
  RangeStr:String;
begin
  NoOutFieldsPresent:=False;
  //Предварительная подготовка
  Excel:=CreateOleObject('Excel.Application');
  Excel.WorkBooks.Add;
  Sheet:=Excel.WorkBooks[1].ActiveSheet;
  Excel.Visible:=True;
  //Наименования стролбцов
  if VarType(Names) and VarArray = VarArray then
    begin
      //Вывод наименований столбцов
      counter:=0;
      for i:=VarArrayLowBound(Names,1) to VarArrayHighBound(Names,1) do
        begin
          RangeStr:=Format('%s%s',[ExInc(TableHeadStartCol,counter),TableHeadRow]);
          Sheet.Range[RangeStr].Value:=Names[i];
          Sheet.Range[RangeStr].HorizontalAlignment:=$FFFFEFF4;
          Sheet.Range[RangeStr].VerticalAlignment:=$FFFFEFF4;
          Sheet.Range[RangeStr].Font.Bold:=True;
          Sheet.Range[RangeStr].Font.Name:=TableHeadFontName;
          Sheet.Range[RangeStr].Font.Size:=TableHeadFontSize;
          inc(Counter);
        end;
    end;
  //"Невыводимые" поля
  if VarType(NotOut) and VarArray = VarArray then
    begin
      Data:=VarArrayCreate([1,ds.RecordCount,1,ds.Fields.Count-VarArrayHighBound(NotOut,1)],varVariant);
      NoOutFieldsPresent:=true;
    end
  else
    Data:=VarArrayCreate([1,ds.RecordCount,1,ds.Fields.Count],varVariant);
  //Расчет "ширины" таблицы, очевидна что она будет равна количеству столбцов
  TableWidth:=VarArrayHighBound(data,2);
  //Наименование таблицы
  Sheet.Range[Format('%s%s',[TitleCol,TitleRow])].Value:=TableName;
  RangeStr:=Format('%s%s:%s%s',[TitleCol,TitleRow,ExInc(TitleCol,TableWidth-1),TitleRow]);
  Sheet.Range[RangeStr].Merge;
  Sheet.Range[RangeStr].HorizontalAlignment:=$FFFFEFF4;
  Sheet.Range[RangeStr].VerticalAlignment:=$FFFFEFF4;
  Sheet.Range[RangeStr].Font.Bold:=True;
  Sheet.Range[RangeStr].Font.Name:=TitleFontName;
  Sheet.Range[RangeStr].Font.Size:=TitleFontSize;
  NoOutCounter:=1;
  NoOutCounterNeedInc:=False;
  for i:=1 to ds.Fields.Count do
    begin
      ds.First;
      if NoOutCounterNeedInc then
        begin
          inc(NoOutCounter);
          NoOutCounterNeedInc:=False;
        end;
      for j:=1 to ds.RecordCount do
        begin
          if NoOutFieldsPresent then
            begin
              if CheckField(ds.Fields[i-1].FieldName,NotOut) then
                begin
                  Data[j,NoOutCounter]:=ds.Fields[i-1].Value;
                  NoOutCounterNeedInc:=True;
                end;
            end
          else
            begin
              Data[j,i]:=ds.Fields[i-1].Value;
            end;
          ds.Next;
        end
    end;
  if VarType(NotOut) and VarArray = VarArray then
    begin
      RangeStr:=Format('%s%s:%s%d',[TableDataStartCol,TableDataStartRow,chr(65+IfThen(NoOutFieldsPresent,ds.Fields.Count-VarArrayHighBound(NotOut,1),ds.Fields.Count)),4+ds.RecordCount]);
      Sheet.Range[RangeStr].Value:=Data;
    end
  else
    begin
      RangeStr:=Format('%s%s:%s%d',[TableDataStartCol,TableDataStartRow,chr(65+ds.Fields.Count),4+ds.RecordCount]);
      Sheet.Range[RangeStr].Value:=Data;
    end;
  //Украшательство
  Sheet.Range[RangeStr].Font.Name:=TableDataFontName;
  Sheet.Range[RangeStr].Font.Size:=TableDataFontSize;
  //Удаленнные записи
  if isDeletePresent then
    begin
      ds.First;
      for i:=1 to ds.RecordCount do
        begin
          if ds.FieldByName('isDeleted').AsBoolean then
            begin
              //Рассчет нахождения удаленной строки
              RangeStr:=Format('%d:%d',[StrToInt(TableDataStartRow)+i-1,StrToInt(TableDataStartRow)+i-1]);
              //Украшалка
              Sheet.Range[RangeStr].Font.Italic:=True;
            end;
          ds.Next;
        end;
    end;
  //Последнее украшательство
  Sheet.Cells.Select;
  Sheet.Cells.EntireColumn.AutoFit;
  Sheet.Range['A1'].Select;
end;

end.
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
Эти 4 пользователя(ей) сказали Спасибо Aristarh Dark за это полезное сообщение:
gewasop (06.05.2015), kucher (20.10.2015), Yurk@ (18.02.2013), Малая (06.03.2015)
  #2  
Старый 14.05.2010, 11:18
Аватар для Страдалецъ
Страдалецъ Страдалецъ вне форума
Гуру
 
Регистрация: 09.03.2009
Адрес: На курорте, из окна вижу теплое Баренцево море. Бррр.
Сообщения: 4,723
Репутация: 52347
По умолчанию

Добавьте еще пример вызова.
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
Ответить с цитированием
  #3  
Старый 15.05.2010, 05:19
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Страдалецъ, вот Вы и напишите, в Ваших способностях я не сомневаюсь
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #4  
Старый 18.05.2010, 12:17
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Немного дополнил (пока beta):
Код:
unit ExportToExcel;
{
  Модуль для передачи данных в Excel из любого наследника TDataSet

  (c) Aristarh Dark (2010)
  e-mail: aristarh.dark@gmail.com
  ver 2.0 beta

  Зависимости:
  DB, SysUtils, ComObj, Variants, Math;

  Небольшое описание:
  ds              - набор данных по которому надо построить таблицу в эксель
  TableName       - выводимый заголовок таблицы
  Names           - вариантрый массив имен столбцов, имена должны следовать в том же
                    порядке, что и выводимые поля в наборе данных
  NotOut          - вариантный массив имен полей набора данных которые выводить не
                    следует, поля в массиве следовали в том же порядке что и в наборе
  Total           - вариантный массив имен полей набора данных для которых следует
                    подсчитать общий итог по столбцу. Поля должны следовать в томже
                    порядке, что и в наборе.
                    ФИЧИ:
                    1. Предпологается что первый столбец не суммируется (в него пишется ИТОГО)
                    2. Пока не работает для таких наборов данных в которых есть невыводимые поля,
                       т.е. массив NoOut должен быть пуст (или не массив ;))
  isDeletePresent - это моя собственная примочка, т.к. в любой таблице я использую
                    поле isDeleted (признак удаленной записи), то такие записи я
                    хотел бы видеть и в результирующей таблице в Excel. В моем
                    варианте они выделяются курсивом.

  Модуль свободен для использования и изменения, ссылка на автора желательна

  Тестировалось на Excel 2003
  Тестировалось на Excel 2007
}
interface
uses
  DB;

procedure ToExcel(ds:TDataSet;TableName:String;Names,NotOut,Total:Variant;isDeletePresent:boolean = True);

implementation
uses
  SysUtils, ComObj, Variants, Math;

const
  TitleRow          = '2';
  TitleCol          = 'B';
  TitleFontName     = 'Times New Roman';
  TitleFontSize     = 12;

  TableHeadRow      = '4';
  TableHeadStartCol = 'B';
  TableHeadFontName = 'Courier New';
  TableHeadFontSize = 12;

  TableDataStartRow = '5';
  TableDataStartCol = 'B';
  TableDataFontName = 'Courier New';
  TableDataFontSize = 12;

  GrandTotalFontName = 'Courier New';
  GrandTotalFontSize = 12;

function ExInc(value:string;delta:integer = 1;trend:boolean = true):string;
{
   Сложение/вычитание координат Excel
   value - значение (буквенная координата столбца)
   delta - коэффициент приращения [1]
   trend - направление приращения .t. - сложение, .f. - вычитание [.t.]

   ВНИМАНИЕ!!
   работает только до 'ZZ'
}
var
  numeric:integer;
  low,hig:integer;
begin
  if not(trend) then
    delta:=delta*(-1);
  if Length(value)>1 then
     numeric:=(ord(value[1])-64)*26+(ord(value[2])-64)
  else
     numeric:=ord(value[1])-64;
  numeric:=numeric+delta;
  if numeric>26 then
    begin
      low:=numeric-(26*Trunc(numeric/26));
      hig:=Trunc(numeric/26);
      if low=0 then
        begin
          low:=26;
          hig:=hig-1;
        end;
      result:=chr(hig+64)+chr(low+64);
    end
  else
     result:=chr(64+numeric);
end;

function GetTotalFieldPos(FieldName:string;Data:Variant):integer;
var
  i:integer;
begin
  Result:=-1;
  for i:=VarArrayLowBound(data,1) to VarArrayHighBound(data,1) do
    if AnsiUpperCase(FieldName)=AnsiUpperCase(data[i]) then
      Result:=i;
end;

function CheckField(FieldName:string;Data:Variant):boolean;
var
  i:integer;
begin
  Result:=True;
  for i:=VarArrayLowBound(data,1) to VarArrayHighBound(data,1) do
    if AnsiUpperCase(FieldName)=AnsiUpperCase(data[i]) then
      Result:=False;
end;
procedure ToExcel(ds:TDataSet;TableName:String;Names,NotOut,Total:Variant;isDeletePresent:boolean = True);
var
  Excel:OleVariant;
  Sheet:OleVariant;
  Data:Variant;
  GrandTotal:Variant;
  GrandTotalOut:Variant;
  i,j:integer;
  gtPos:integer;
  counter:integer;
  NoOutFieldsPresent:boolean;
  NoOutCounter:integer;
  NoOutCounterNeedInc:boolean;
  GrandTotalPresent:boolean;
  TableWidth:integer;
  RangeStr:String;
begin
  NoOutFieldsPresent:=False;
  GrandTotalPresent:=False;
  Excel:=CreateOleObject('Excel.Application');
  Excel.WorkBooks.Add;
  Sheet:=Excel.WorkBooks[1].ActiveSheet;
  Excel.Visible:=True;
  if VarType(Names) and VarArray = VarArray then
    begin
      counter:=0;
      for i:=VarArrayLowBound(Names,1) to VarArrayHighBound(Names,1) do
        begin
          RangeStr:=Format('%s%s',[ExInc(TableHeadStartCol,counter),TableHeadRow]);
          Sheet.Range[RangeStr].Value:=Names[i];
          Sheet.Range[RangeStr].HorizontalAlignment:=$FFFFEFF4;
          Sheet.Range[RangeStr].VerticalAlignment:=$FFFFEFF4;
          Sheet.Range[RangeStr].Font.Bold:=True;
          Sheet.Range[RangeStr].Font.Name:=TableHeadFontName;
          Sheet.Range[RangeStr].Font.Size:=TableHeadFontSize;
          inc(Counter);
        end;
    end;
  if VarType(NotOut) and VarArray = VarArray then
    begin
      Data:=VarArrayCreate([1,ds.RecordCount,1,ds.Fields.Count-VarArrayHighBound(NotOut,1)],varVariant);
      NoOutFieldsPresent:=true;
    end
  else
    Data:=VarArrayCreate([1,ds.RecordCount,1,ds.Fields.Count],varVariant);
  //Нужно ли рассчитывать ИТОГИ
  if VarType(Total) and VarArray = VarArray then
    begin
      GrandTotal:=VarArrayCreate([1,VarArrayHighBound(Total,1)],varVariant);
      GrandTotalPresent:=True;
    end;
  TableWidth:=VarArrayHighBound(data,2);
  Sheet.Range[Format('%s%s',[TitleCol,TitleRow])].Value:=TableName;
  RangeStr:=Format('%s%s:%s%s',[TitleCol,TitleRow,ExInc(TitleCol,TableWidth-1),TitleRow]);
  Sheet.Range[RangeStr].Merge;
  Sheet.Range[RangeStr].HorizontalAlignment:=$FFFFEFF4;
  Sheet.Range[RangeStr].VerticalAlignment:=$FFFFEFF4;
  Sheet.Range[RangeStr].Font.Bold:=True;
  Sheet.Range[RangeStr].Font.Name:=TitleFontName;
  Sheet.Range[RangeStr].Font.Size:=TitleFontSize;
  NoOutCounter:=1;
  NoOutCounterNeedInc:=False;
  for i:=1 to ds.Fields.Count do
    begin
      ds.First;
      if NoOutCounterNeedInc then
        begin
          inc(NoOutCounter);
          NoOutCounterNeedInc:=False;
        end;
      for j:=1 to ds.RecordCount do
        begin
          if NoOutFieldsPresent then
            begin
              if CheckField(ds.Fields[i-1].FieldName,NotOut) then
                begin
                  Data[j,NoOutCounter]:=ds.Fields[i-1].Value;
                  NoOutCounterNeedInc:=True;
                  if GrandTotalPresent and (GetTotalFieldPos(ds.Fields[i-1].FieldName,Total)>0) then
                    GrandTotal[GetTotalFieldPos(ds.Fields[i-1].FieldName,Total)]:=
                      GrandTotal[GetTotalFieldPos(ds.Fields[i-1].FieldName,Total)]+ds.Fields[i-1].Value;
                end;
            end
          else
            begin
              Data[j,i]:=ds.Fields[i-1].Value;
              if GrandTotalPresent then
                begin
                  gtPos:=GetTotalFieldPos(ds.Fields[i-1].FieldName,Total);
                  if gtPos>0 then
                    GrandTotal[gtPos]:=GrandTotal[gtPos]+ds.Fields[i-1].Value;
                end;
            end;
          ds.Next;
        end
    end;
  if VarType(NotOut) and VarArray = VarArray then
    begin
      RangeStr:=Format('%s%s:%s%d',[TableDataStartCol,TableDataStartRow,chr(65+IfThen(NoOutFieldsPresent,ds.Fields.Count-VarArrayHighBound(NotOut,1),ds.Fields.Count)),4+ds.RecordCount]);
      Sheet.Range[RangeStr].Value:=Data;
    end
  else
    begin
      RangeStr:=Format('%s%s:%s%d',[TableDataStartCol,TableDataStartRow,chr(65+ds.Fields.Count),4+ds.RecordCount]);
      Sheet.Range[RangeStr].Value:=Data;
    end;
  Sheet.Range[RangeStr].Font.Name:=TableDataFontName;
  Sheet.Range[RangeStr].Font.Size:=TableDataFontSize;
  if isDeletePresent then
    begin
      ds.First;
      for i:=1 to ds.RecordCount do
        begin
          if ds.FieldByName('isDeleted').AsBoolean then
            begin
              RangeStr:=Format('%d:%d',[StrToInt(TableDataStartRow)+i-1,StrToInt(TableDataStartRow)+i-1]);
              Sheet.Range[RangeStr].Font.Italic:=True;
            end;
          ds.Next;
        end;
    end;
  //Вывод итогов
  if GrandTotalPresent then
    begin
      //Создаем массив равный по ширине таблице, а по высоте в 1 строку
      GrandTotalOut:=VarArrayCreate([1,1,1,TableWidth],varVariant);
      //Переносим значения в "правильные" ячейки массива
      i:=0;
      j:=1;
      while i<ds.FieldCount do
        begin
          if NoOutFieldsPresent then
            begin
              //Здесь надо проработать
            end
          else
            begin
              if GetTotalFieldPos(ds.Fields[i].FieldName,total)>0 then
                begin
                  GrandTotalOut[1,i+1]:=GrandTotal[j];
                  inc(j);
                end
            end;
          inc(i);
        end;
      //Предполагается что первый столбец в таблице не суммируется
      GrandTotalOut[1,1]:='ИТОГО:';
      //Расчет позиции вывода массива
      RangeStr:=Format('%s%d:%s%d',[TableDataStartCol,StrToInt(TableDataStartRow)+ds.RecordCount,
        ExInc(TableHeadStartCol,TableWidth-1),StrToInt(TableDataStartRow)+ds.RecordCount]);
      Sheet.Range[RangeStr].Value:=GrandTotalOut;
      Sheet.Range[RangeStr].Font.Name:=GrandTotalFontName;
      Sheet.Range[RangeStr].Font.Size:=GrandTotalFontSize;
      Sheet.Range[RangeStr].Font.Bold:=True;
    end;
  Sheet.Cells.Select;
  Sheet.Cells.EntireColumn.AutoFit;
  Sheet.Range['A1'].Select;
end;
end.
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо Aristarh Dark за это полезное сообщение:
gewasop (06.05.2015), Yurk@ (18.02.2013)
  #5  
Старый 23.05.2010, 12:58
netruxa netruxa вне форума
Прохожий
 
Регистрация: 21.02.2010
Сообщения: 5
Репутация: 10
По умолчанию моя версия экспорта в эксель

Вот как я делаю экспорт... Вроде попроще код, может кому пригодится

Код:
procedure TfMain.Button5Click(Sender: TObject);
var
 XL, XArr: Variant;
 i: Integer;
 j: Integer;
begin
XArr:=VarArrayCreate([1,DM.qTabl1.FieldCount],varVariant);
 XL:=CreateOLEObject('Excel.Application');     
 XL.WorkBooks.add;

 XL.Range['A1','A1'].Value := 'заголовок 1';
  XL.Range['B1','B1'].Value := '...';


 j := 2;
 DM.qTabl1.First;
 while not DM.qTabl1.Eof do
  begin
   i:=1;
   while i<=DM.qTabl1.FieldCount do
    begin
     XArr[i] := DM.qTabl1.Fields[i-1].Value;
     i := i+1;
    end;
      XL.Range['A'+IntToStr(j),
   CHR(64+DM.qTabl1.FieldCount)+IntToStr(j)].Value := XArr;
   DM.qTabl1.Next;
   j:=j+1;
  end;


 XL.Range['A1',CHR(64+DM.qTabl1.FieldCount)+IntToStr(j)].select;

 XL.Selection.Font.Name:='Arial cur';
 XL.Selection.Font.Size:=10;
 XL.Selection.ColumnWidth:=10;
 XL.Selection.RowHeight:=15;

   with SaveDialog1 do
      if Execute then
      xl.ActiveWorkbook.SaveAs(FileName);


 XL.Range['A1','A1'].select;
  XL.visible:=true;
end;
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо netruxa за это полезное сообщение:
Aibekkoke (12.03.2022), gewasop (06.05.2015)
  #6  
Старый 13.08.2010, 02:16
Deadwoolf Deadwoolf вне форума
Прохожий
 
Регистрация: 13.08.2010
Сообщения: 5
Репутация: 10
Печаль Help

помогите кто может.. делаю программу в которой будет много значений каторые динамически обновляюца ну ето не важно. дапустим нада 3 значения постоянно экспортировать в эксель как бы лог такой что бы в эксели ани шли (время....данные1....данные2...данные3) такова вида. и при желании пользователя данные выводились в программе дапустим он выбрал определенный день и ему программа паказала какие данные были занесены в етот день... заранее огромное спасибо!!!
Ответить с цитированием
  #7  
Старый 18.08.2010, 03:13
Deadwoolf Deadwoolf вне форума
Прохожий
 
Регистрация: 13.08.2010
Сообщения: 5
Репутация: 10
По умолчанию

разобрался с экспортом в бд использую аксес ( оказалось все намного проще чем думал )
Ответить с цитированием
  #8  
Старый 05.09.2010, 23:27
Аватар для ProFFi07
ProFFi07 ProFFi07 вне форума
Прохожий
 
Регистрация: 05.09.2010
Сообщения: 2
Репутация: 10
По умолчанию

Доброго суток дня, народ.
При переносе данных в excel, в ячейках где добавлены данные c dbmemo после каждой строки отображается квадратный символ т.е. в dbmemo - это был перенос строки (путём enter).
Как мне сделать эти квадратные символы невидимыми?
Помогите плизз.
Ответить с цитированием
  #9  
Старый 06.09.2010, 05:24
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Заменить перед выводом на пробел
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #10  
Старый 06.09.2010, 10:25
Аватар для ProFFi07
ProFFi07 ProFFi07 вне форума
Прохожий
 
Регистрация: 05.09.2010
Сообщения: 2
Репутация: 10
По умолчанию

Дело в том, что я сейчас так и делаю. Очень неудобно и трудоёмко получается - чтобы квадратиков не было и следующая строка начиналась заново надо в предыдущей строке как минимум 20 пробелов ставить, а мемо полей у меня много...
Должен же быть способ исключить данную проблему..
Кстати, в Висте он нормально работает(без квадратиков).
Ответить с цитированием
  #11  
Старый 09.09.2010, 12:10
lida lida вне форума
Прохожий
 
Регистрация: 07.04.2010
Сообщения: 3
Репутация: 10
По умолчанию Передача данных в Excel

Здравствуйте, уважаемые! Такой вопрос, передаю данные в Excel, но что то очень долго он думает при передачи данных, может уже кто сталкивался с таким, может я забыла что написать. Всем спасибо.
Ответить с цитированием
  #12  
Старый 09.09.2010, 12:25
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

lida, может стоило код показать, а то телепаты в отпуске.
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #13  
Старый 22.10.2010, 11:19
o6619 o6619 вне форума
Прохожий
 
Регистрация: 21.10.2010
Сообщения: 3
Репутация: 10
По умолчанию

Цитата:
Сообщение от ProFFi07
Дело в том, что я сейчас так и делаю. Очень неудобно и трудоёмко получается - чтобы квадратиков не было и следующая строка начиналась заново надо в предыдущей строке как минимум 20 пробелов ставить, а мемо полей у меня много...
Должен же быть способ исключить данную проблему..
Кстати, в Висте он нормально работает(без квадратиков).
Заменить #13#10 на #10.
Ответить с цитированием
  #14  
Старый 07.11.2010, 08:40
Аватар для Voron
Voron Voron вне форума
Новичок
 
Регистрация: 16.09.2010
Сообщения: 61
Репутация: 10
По умолчанию RE:-)

Попробуй этот код. Подключи модуль Exel97 и пользуйся на здоровье!

PHP код:
procedure TForm13.BitBtn1Click(SenderTObject);
Var 
ExcelApplication:Variant;
i1,i2,i3,i4,i,rInteger;
t,t2,t1string;
begin
r
:=0;

if 
form1.RzSelectFolderDialog1.Execute then t1:=form1.RzSelectFolderDialog1.SelectedPathName+'\'+form13.Edit1.Text+'.xls';
form13.Label2.Caption:=t1;
if fileexists(t1) then
begin
  if messagedlg('
Данный файл уже существуетПерезаписать?', mtwarning,[mbYes,mbNo,MbCancel],0)=idYes
  then
  begin
    try
     ExcelApplication:= GetActiveOleObject('
Excel.Application');
    except
     ExcelApplication:= CreateOleObject('
Excel.Application');
    end;
    dm.Query2.First;

    while not dm.Query2.Eof do
    begin
    r:=r+1;
    dm.Query2.Next;
    end;

    ExcelApplication.WorkBooks.open(t1);
    for i:=1 to 10 do
       ExcelApplication.Cells[1,i].value:=dm.Query2.Fields[i-1].FieldName;
       dm.Query2.First;
       while not dm.Query2.Eof do
       begin
       for i:=2 to r+1 do begin
       for i1:=0 to 9 do
       ExcelApplication.Cells[i,i1+1].value:=dm.Query2.Fields[i1].AsString;
       dm.Query2.Next;
       end;
       ExcelApplication.Cells[r+2,1].value:='
Агрегации';
       ExcelApplication.Cells[r+3,1].value:='
Сумма';
       ExcelApplication.Cells[r+4,1].value:='
Среднее значение';
       ExcelApplication.Cells[r+5,1].value:='
Максимум';
       ExcelApplication.Cells[r+6,1].value:='
Минимум';

       ExcelApplication.Cells[r+3,2].value:='
=СУММ(J2:'+'J'+inttostr(r+1)+')';
       ExcelApplication.Cells[r+4,2].value:='
=СРЗНАЧ(J2:'+'J'+inttostr(r+1)+')';
       ExcelApplication.Cells[r+5,2].value:='
=МАКС(J2:'+'J'+inttostr(r+1)+')';
       ExcelApplication.Cells[r+6,2].value:='
=МИН(J2:'+'J'+inttostr(r+1)+')';


       end;
end else begin
 try
     ExcelApplication:= GetActiveOleObject('
Excel.Application');
    except
     ExcelApplication:= CreateOleObject('
Excel.Application');
    end;
    dm.Query2.First;

    while not dm.Query2.Eof do
    begin
    r:=r+1;
    dm.Query2.Next;
    end;

    ExcelApplication.WorkBooks.open(t1);
    for i:=1 to 10 do
       ExcelApplication.Cells[1,i].value:=dm.Query2.Fields[i-1].FieldName;
       dm.Query2.First;
       while not dm.Query2.Eof do
       begin
       for i:=2 to r+1 do begin
       for i1:=0 to 9 do
       ExcelApplication.Cells[i,i1+1].value:=dm.Query2.Fields[i1].AsString;
       dm.Query2.Next;
       end;
       ExcelApplication.Cells[r+2,1].value:='
Агрегации';
       ExcelApplication.Cells[r+3,1].value:='
Сумма';
       ExcelApplication.Cells[r+4,1].value:='
Среднее значение';
       ExcelApplication.Cells[r+5,1].value:='
Максимум';
       ExcelApplication.Cells[r+6,1].value:='
Минимум';

       ExcelApplication.Cells[r+3,2].value:='
=СУММ(J2:'+'J'+inttostr(r+1)+')';
       ExcelApplication.Cells[r+4,2].value:='
=СРЗНАЧ(J2:'+'J'+inttostr(r+1)+')';
       ExcelApplication.Cells[r+5,2].value:='
=МАКС(J2:'+'J'+inttostr(r+1)+')';
       ExcelApplication.Cells[r+6,2].value:='
=МИН(J2:'+'J'+inttostr(r+1)+')';

       end;
       end;
       end;
       close;

end; 
Ответить с цитированием
  #15  
Старый 24.07.2011, 20:20
iegrec iegrec вне форума
Прохожий
 
Регистрация: 07.01.2011
Сообщения: 34
Репутация: 10
По умолчанию

Здравствуйте! подскажите пожалуйста а как из DBGrid ->Excel по шаблону.
т.е шаблоны в Exel and Word я заполняю нормально а вот из DBGrid не могу..т.е у меня в шаблоне есть строка #Сумма& вот и мне нужно из DBGrid колонку sum передать в шаблон #Сумма& Помогите разобраться как это сделать из DBGrid...
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 15:07.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter