delphi 7 и Excel экспорт в Эксель

sdmitriy84 · #1 08.02.2017, 16:10

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

Код:

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 сделать проверку повторяющейся информации в ячейках и обьеденить ячейки, которые повторяются, а так же сделать суммирование поля "итого" повторяющихся ячеек и вывести в конце этих ячеек. Сколько пытаюсь сделать не получается.

Заранее благодарен всем кто откликнется...))

lmikle · #2 08.02.2017, 20:05

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

sdmitriy84 · #3 09.02.2017, 09:40

А можно код хотя бы примерный, я уже 3 месяца ни как не могу слепить его..

lmikle · #4 09.02.2017, 19:49

ну, могу накидать пример, разбираться с твоим кодом лень, да и условие повторяемости непонятно.
Примерно так:

Код:

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 - собственно вставка строки по данным.

sdmitriy84 · #5 16.02.2017, 14:52

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

Код:

  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

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты