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

Delphi Sources



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

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 08.02.2017, 16:10
sdmitriy84 sdmitriy84 вне форума
Прохожий
 
Регистрация: 28.07.2015
Сообщения: 3
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию delphi 7 и Excel экспорт в Эксель

Всем форумчанам привет, люди добрые помогите мне разобраться в коде

Код:
procedure TForm9.btn4Click(Sender: TObject);
var
  ExcelApp, sheet, XLA, exRng: variant;
  index, i: integer;
const
  xlContinuous = 1;
  xlThin = 2;
begin
  j := FloatToStr(dbsmlst1.SumCollection.Items[0].SumValue);
  k := StrToInt(j);
  l := FloatToStr(dbsmlst1.SumCollection.Items[1].SumValue);
  n := StrToInt(l);
  b := FloatToStr(dbsmlst1.SumCollection.Items[2].SumValue);
  c := StrToInt(b);
  XLA := CreateOleObject('Excel.Application');
  XLA.workbooks.open(ExtractFilePath(ParamStr(0)) + 'test1.xls');
  XLA.Visible := true;
  XLA.WorkBooks[1].WorkSheets[1].Name := 'Сводный отчет';
  ExcelApp := XLA.workbooks[1].worksheets['Сводный отчет'].columns;
  ExcelApp.columns[1].ColumnWidth := 5;
  ExcelApp.columns[2].ColumnWidth := 35.71;
  ExcelApp.columns[3].ColumnWidth := 10;
  ExcelApp.columns[4].ColumnWidth := 8.14;
  ExcelApp.columns[5].ColumnWidth := 16.86;
  ExcelApp.columns[6].ColumnWidth := 5;
  ExcelApp.columns[7].ColumnWidth := 51.14;
  ExcelApp.columns[8].ColumnWidth := 6.29;
  ExcelApp.columns[9].ColumnWidth := 6.71;
  ExcelApp.columns[10].ColumnWidth := 11.71;
  ExcelApp.columns[11].ColumnWidth := 10.86;
  ExcelApp.columns[12].ColumnWidth := 10;
  ExcelApp.columns[13].ColumnWidth := 7.86;
  ExcelApp := XLA.workbooks[1].worksheets['Сводный отчет'].Rows;
  ExcelApp.Rows[9].font.bold := true;
  ExcelApp.Rows[9].font.size := 10;
  ExcelApp.Rows[9].font.color := clBlue;
  ExcelApp.Rows[9].wraptext := true;
  sheet := XLA.workbooks[1].worksheets['Сводный отчет'];
  Sheet.cells[9, 1] := '№ п\п';
  Sheet.cells[9, 2] := 'ФИО застрахованного';
  Sheet.cells[9, 3] := 'Дата рождения';
  Sheet.cells[9, 4] := 'Подразделение';
  Sheet.cells[9, 5] := 'Полис №';
  Sheet.cells[9, 6] := 'Код усл.';
  Sheet.cells[9, 7] := 'Наименование усл.';
  Sheet.cells[9, 8] := 'Кол-во';
  Sheet.cells[9, 9] := 'Цена';
  Sheet.cells[9, 10] := 'Дата оказания';
  Sheet.cells[9, 11] :='Код исполнителя';
  Sheet.cells[9, 12] :='Шифр забол-я';
  Sheet.cells[9, 13] :='Итого';
  index := 10;
  with ds1.DataSet do
  begin
    First;
    for i := 0 to RecordCount -1 do
    begin
      sheet.cells[4, 1] := 'добровольного медицинского страхования за период c ' + Fields.Fields[31].AsString + ' по ' + Fields.Fields[32].AsString;
      sheet.cells[index, 1] :=i+1;
      sheet.cells[index, 2] := Fields.Fields[3].AsString + ' ' + Fields.Fields[4].AsString + ' ' + Fields.Fields[5].AsString;;
      sheet.cells[index, 3] := Fields.Fields[7].AsString;
      sheet.cells[index, 4] := Fields.Fields[14].AsString;
      sheet.cells[index, 5] := Fields.Fields[11].AsString;
      sheet.cells[index, 6] := Fields.Fields[25].AsString;
      sheet.cells[index, 7] := Fields.Fields[36].AsString;
      sheet.cells[index, 8] := Fields.Fields[26].AsString;
      sheet.cells[index, 9] := Fields.Fields[27].AsString;
      sheet.cells[index, 10] := Fields.Fields[28].AsString;
      sheet.cells[index, 11] := Fields.Fields[41].AsString;
      sheet.cells[index, 12] := Fields.Fields[47].AsString;
      sheet.cells[index, 13] := Fields.Fields[33].AsString;
      sheet.cells[index, 14] := index;
      Inc(index);
      Next;
    end
  end;
  exRng := Sheet.Range[Sheet.Cells[9, 1], Sheet.Cells[index, 13]];
  exRng.Borders.LineStyle := xlContinuous;
  exRng.Borders.Weight := xlThin;
  exRng.Rows.AutoFit;
  XLA.WorkBooks[1].Sheets[1].Cells[10 + k, 13].value := n;
  XLA.WorkBooks[1].Sheets[1].Cells[10 + k, 8].value := c;
 //  XLA.Visible := true;
end;

сам код рабочий только мне нужно еще при экспорте в excel сделать проверку повторяющейся информации в ячейках и обьеденить ячейки, которые повторяются, а так же сделать суммирование поля "итого" повторяющихся ячеек и вывести в конце этих ячеек. Сколько пытаюсь сделать не получается.

Заранее благодарен всем кто откликнется...))
Ответить с цитированием
  #2  
Старый 08.02.2017, 20:05
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,003
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Лень код писать.
Собственно, тебе нужы переменные, в которых у тебя будут расположены:
1. Счетчик записей
2. Значения ключевых полей (по которым определяется "повторение" записей).
3. Переменную для суммирования ИТОГО
Перед циклом счетчик = 0, все переменных ключ. значений - пустая строка.
Перед вставкой очередной записи:
1. Проверяем по ключевым полям. Если повторяется - увеличиваем счетчик и итог и НЕ вставляем
2. Если не совпадает, то:
2.1. Проверяем счетчик. Если > 1, то вставляем итоговую запись
2.2. Вставляем новую запись
2.3. Сбрасываем счетчик и итог и обновляем переменные ключевых полей
Ответить с цитированием
  #3  
Старый 09.02.2017, 09:40
sdmitriy84 sdmitriy84 вне форума
Прохожий
 
Регистрация: 28.07.2015
Сообщения: 3
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

А можно код хотя бы примерный, я уже 3 месяца ни как не могу слепить его..
Ответить с цитированием
  #4  
Старый 09.02.2017, 19:49
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,003
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

ну, могу накидать пример, разбираться с твоим кодом лень, да и условие повторяемости непонятно.
Примерно так:
Код:
var
  KayValue1, KeyValue2 : String;
  Cnt : Integer;
  Total : Double;
begin
  DataSet.First;
  KeyValue1 := '';
  KeyValue2 := '';
  Cnt := 0;
  Total := 0.0;
  While Not DataSet.Eof Do
    Begin
      If (DataSet.FieldByName('Key1').AsString <> KeyValue1) Or (DataSet.FieldByName('Key2').AsString <> KeyValue2) 
        Then
           Begin
             If Cnt > 1 Then InsertTotalRow(); // Вставляем итоговую строку
             Cnt := 1;
             Total := DataSet.FieldByName('Value').AsFloat;
             KeyValue1 := DataSet.FieldByName('KeyValue1').AsString;
             KeyValue2 := DataSet.FieldByName('KeyValue2').AsString;
             InsertRow(); // Вставляем текущую строку             
           End
        Else
           Begin
             Inc(Cnt);
             Total := Total + DataSet.FieldByName('Value').AsFloat;
           End
      DataSet.Next;
    End;
end;

Что-то типа так.
InsertRow и InsertTotalRow - собственно вставка строки по данным.
Ответить с цитированием
  #5  
Старый 16.02.2017, 14:52
sdmitriy84 sdmitriy84 вне форума
Прохожий
 
Регистрация: 28.07.2015
Сообщения: 3
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Сделал вот так

Код:
  index := 10;
  KeyValue1 := '';
  KeyValue2 := '';
  Cnt := 0;
  cnt2 := 0;
  cnt3:=0;
  with ds1.DataSet do
  begin
    sheet.cells[4, 1] := 'добровольного медицинского страхования за период c ' + ds1.DataSet.FieldByName('period_c').AsString + ' по ' + ds1.DataSet.FieldByName('period_po').AsString;
    First;
    while not ds1.DataSet.Eof do
    begin
        if (ds1.DataSet.FieldByName('Фамилия').AsString + ' ' + ds1.DataSet.FieldByName('Имя').AsString + ' ' + ds1.DataSet.FieldByName('Отчество').AsString <> KeyValue1) then
        begin
          Inc(cnt);
          keyvalue1 := ds1.DataSet.FieldByName('Фамилия').AsString + ' ' + ds1.DataSet.FieldByName('Имя').AsString + ' ' + ds1.DataSet.FieldByName('Отчество').AsString;
          keyvalue2 := ds1.DataSet.FieldByName('kod').AsString;
          sheet.cells[index, 1] := cnt;
          sheet.cells[index, 2] := ds1.DataSet.FieldByName('Фамилия').AsString + ' ' + ds1.DataSet.FieldByName('Имя').AsString + ' ' + ds1.DataSet.FieldByName('Отчество').AsString;
          sheet.cells[index, 3] := Fields.Fields[7].AsString;
          sheet.cells[index, 4] := Fields.Fields[14].AsString;
          sheet.cells[index, 5] := Fields.Fields[11].AsString;
          sheet.cells[index, 6] := Fields.Fields[25].AsString;
          sheet.cells[index, 7] := Fields.Fields[36].AsString;
          sheet.cells[index, 8] := Fields.Fields[26].AsString;
          sheet.cells[index, 9] := Fields.Fields[27].AsString;
          sheet.cells[index, 10] := Fields.Fields[28].AsString;
          sheet.cells[index, 11] := Fields.Fields[41].AsString;
          sheet.cells[index, 12] := Fields.Fields[47].AsString;
          sheet.cells[index, 13] := Fields.Fields[33].AsString;
        end;
      if (ds1.DataSet.FieldByName('Kod').AsString <> KeyValue2) then
      begin
        sheet.cells[index, 6] := Fields.Fields[25].AsString;
        sheet.cells[index, 7] := Fields.Fields[36].AsString;
        sheet.cells[index, 8] := Fields.Fields[26].AsString;
        sheet.cells[index, 9] := Fields.Fields[27].AsString;
        sheet.cells[index, 10] := Fields.Fields[28].AsString;
        sheet.cells[index, 11] := Fields.Fields[41].AsString;
        sheet.cells[index, 12] := Fields.Fields[47].AsString;
        sheet.cells[index, 13] := Fields.Fields[33].AsString;
      end;
      inc(index);
      ds1.DataSet.Next;
    end;

вот что получилось

http://cm.mf-image.ru/d/eyJ0IjoiMjAxNy0wMi0xNlQxMTo1MzowMi42NzMyOTIwWiIsIn RtIjoxNSwiYmQiOjEsImZkIjo0MTU4Nzg2LCJyZiI6bnVsbCwi c2wiOjAsImZuIjpudWxsLCJyIjoiaHR0cDovL215LWZpbGVzLn J1L3p2dnN4MyIsImwiOm51bGx9.ADF4DB57A9E37F9A7032143 91F6599D7./%D0%91%D0%B5%D0%B7%D1%8B%D0%BC%D1%8F%D0%BD%D0%BD%D 1%8B%D0%B9.JPG

к этому результату необходимо чтобы в конце услуг каждого пациента была строка с итогом по полям (кол-во, цена, итого).

Может кто знает как это реализовать...заранее благодарен за помощь всем кто откликнулся..

Должно выглядеть примерно так

http://v8.mf-image.ru/d/eyJ0IjoiMjAxNy0wMi0xNlQxMjoxMjowNy4yNzcxNzQwWiIsIn RtIjoxNSwiYmQiOjEsImZkIjo0MTU4ODcxLCJyZiI6bnVsbCwi c2wiOjAsImZuIjpudWxsLCJyIjoiaHR0cDovL215LWZpbGVzLn J1LzQ3dTZ6ciIsImwiOm51bGx9.A2199BDC8BD26384748E01A 970F26CFC./%D0%91%D0%B5%D0%B7%D1%8B%D0%BC%D1%8F%D0%BD%D0%BD%D 1%8B%D0%B9.JPG

Последний раз редактировалось sdmitriy84, 16.02.2017 в 15:12.
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter