Создание отчетов в Excel

XL := CreateOLEObject('Excel.Application');
 XL.Workbooks.Open('D:\Program Files\Borland\Delphi7\Projects\ppp\reports\Пенсионеры.xls');
 Sheet := XL.Workbooks[1].workSheets[1];
 Sheet.Name := ;
 Sheet.Cells[2, 3].Font.Italic := True;
 Sheet.Cells[2, 3].Font.Name := 'Times New Roman';
 Sheet.Cells[2, 3].HorizontalAlignment := 1;
 Sheet.Cells[2, 3].Font.Size := 12;
 Sheet.Cells[2, 3] := ' ';
 Sheet.Cells[4, 3].Font.Bold := True;
 Sheet.Cells[4, 3].Font.Italic := True;
 Sheet.Cells[4, 3].Font.Size := 12;
 Sheet.Cells[4, 3].Font.Name := 'Times New Roman';
 Sheet.Cells[4, 3] := ' ' + Self.DBLookupComboboxEh2.Text + ' ' + Self.DBLookupComboboxEh3.Text;
 Sheet.Cells[Q4.RecordCount+9, 2] := + IntToStr(Q4.RecordCount);
 // В 8 строке шапка таблицы. Чтобы выводить ее на каждой странице отчета пишем так
 Sheet.PageSetup.PrintTitleRows := '$8:$8';
 XL.Visible := True;
 XL := UnAssigned;
Author: SeaGirl
Source: Взято из http://forum.sources.ru
ID: 04400
----
if open_excel then
begin
 for i := 1 to ExcelApplication1.Worksheets.Count do
 begin
 ExcelWorksheet2.ConnectTo(ExcelApplication1.Worksheets.Item[i] as ExcelWorksheet);
 if ExcelWorksheet2.Name = DateToStr(DateTimePicker1.Date) then
 begin
 exsist := True;
 it := i;
 end;
 end;
 if exsist then // уже есть такой лист
 ExcelWorksheet1.ConnectTo(ExcelApplication1.Worksheets.item[it] as excelworksheet)
 else
 begin
 ExcelApplication1.Worksheets.Add(EmptyParam, ExcelApplication1.Worksheets.Item[ExcelApplication1.Worksheets.Count] as ExcelWorksheet, EmptyParam, EmptyParam, 1);
 ExcelWorksheet1.ConnectTo(ExcelApplication1.Activesheet as ExcelWorksheet);
 ExcelWorksheet1.Name := DateToStr(DateTimePicker1.Date);
 end;
 // Координаты левого верхнего угла области,
 // в которую будем выводить данные
 Range1 := ExcelWorksheet1.Range['A1', EmptyParam];
 i := 1;
 j := 1;
 ind_cell := 1;
 while j <> 1 do
 begin
 if Range1.value = null then
 begin
 Range2 := ExcelWorksheet1.Range['A' + IntToStr(i+1), EmptyParam];
 if Range2.value = null then
 begin
 Range_empty := Range2;
 Break;
 end
 else
 begin
 i := i + 1;
 Range1 := ExcelWorksheet1.Range['A' + IntToStr(i), EmptyParam];
 end
 end
 else
 begin
 i := i + 1;
 Range1 := ExcelWorksheet1.Range['A' + IntToStr(i), EmptyParam];
 end
 end;
 //Copy(ExcelWorksheet1.Range['A2', EmptyParam], 1, 1);
 //range_temp := ExcelWorksheet1.Range['A2', EmptyParam];
 ind_cell := i; // индекс первого пустого
 if (ind_cell = 2) or (ind_cell = 1) then // до этого ничего не введено
 N_zagot := 1
 else
 begin
 i := 2;
 Range1 := ExcelWorksheet1.Range['A2', EmptyParam];
 //s := Copy(Range_empty.name, 1, 1);
 //ShowMessage(s);
 while i <= ind_cell do
 begin
 if Copy(range1.value, 1, 9) = 'Заготовка' then
 n_zagot := StrToInt(Copy(range1.value, 12, Length(range1.value)-12));
 i := i + 1;
 Range1 := ExcelWorksheet1.Range['A' + IntToStr(i), EmptyParam];
 end;
 end;
 //ExcelWorksheet1.Range['A1', EmptyParam].Value := 'ttt';
 for i := 0 to Length(intervals)-1 do
 begin
 //ExcelWorksheet1.Range['A2', EmptyParam].Columns.AutoFit;
 ExcelWorksheet1.Range['A' + IntToStr(ind_cell+1), EmptyParam].Value := 'Время';
 ExcelWorksheet1.Range['A' + IntToStr(ind_cell+2), EmptyParam].Value := 'Температура';
 for j := 0 to Length(points[i])-1 do
 begin
 if j+2 < 25 then
 s := numb_letters[j+2]
 else
 s := numb_letters[(j+2) div 25] + numb_letters[j+2 mod 25];
 s1 := DateTimeToStr(times[i, j]);
 Delete(s1, 1, 11);
 //temp := Pos(',', ExcelWorksheet1.Range[s + IntToStr(ind_cell+1), EmptyParam].Value);
 //Delete(s1, temp, 1);
 //Insert('.', s1, temp);
 with ExcelWorksheet1.Range[s + IntToStr(ind_cell+1), EmptyParam] do
 begin
 Value := s1;
 Orientation := 90;
 end;
 with ExcelWorksheet1.Range[s + IntToStr(ind_cell+2), EmptyParam] do
 begin
 Value:=points[i, j];
 Orientation:=90;
 end;
 ExcelWorksheet1.Columns.AutoFit;
 //ExcelWorksheet1.Rows('4:4') := 45;
 end;
 ExcelWorksheet1.Range['A' + IntToStr(ind_cell), EmptyParam].Value := 'Заготовка №' + IntToStr(n_zagot);
 with ExcelWorksheet1.Range['A' + IntToStr(ind_cell), s + IntToStr(ind_cell)] do
 begin
 MergeCells := False;
 Merge(emptyparam);
 HorizontalAlignment := xlCenter;
 Font.Italic := True;
 Font.Bold := True;
 Font.Name := 'Times New Roman';
 Font.Size := 14;
 end;
 with ExcelWorksheet1.Range['A' + IntToStr(ind_cell+1), s + IntToStr(ind_cell+2)] do
 begin
 Borders.LineStyle := xlContinuous;
 Font.Name := 'Times New Roman';
 Font.Size := 12;
 end;
 ExcelApplication1.Charts.Add(EmptyParam, ExcelWorksheet1.DefaultInterface, 1, EmptyParam, 1);
 ExcelApplication1.ActiveChart.ChartType := xlLine;
 ExcelApplication1.ActiveChart.SetSourceData(ExcelWorksheet1.Range['A' + IntToStr(ind_cell+1), s + IntToStr(ind_cell+2)], xlRows);
 ExcelApplication1.ActiveChart.Location(xlLocationAsObject, excelworksheet1.Name);
 with ExcelWorksheet1.Shapes.Item((ExcelWorksheet1.ChartObjects as ChartObjects).Count) do
 begin
 Top := ExcelWorksheet1.Range['A1', 'A' + IntToStr(ind_cell+2)].Height + 8;
 Left := 0;
 Width := ExcelWorksheet1.Range['A' + IntToStr(ind_cell+1), s + IntToStr(ind_cell+1)].Width;
 Height := ExcelWorksheet1.Range['A' + IntToStr(ind_cell+3), 'A' + IntToStr(ind_cell+14)].Height;
 end;
 with ExcelApplication1.ActiveChart do
 begin // украшательства диаграммы
 with (Axes(xlCategory, xlPrimary, 1) as Axis) do
 begin
 HasTitle := True;
 AxisTitle.Characters[EmptyParam, EmptyParam].Text := 'Время';
 end;
 with (Axes(xlValue, xlPrimary, 1) as Axis) do
 begin
 HasTitle := True;
 AxisTitle.Characters[EmptyParam, EmptyParam].Text := 'температура';
 end;
 with (Axes(xlCategory, xlPrimary, 1) as Axis) do
 begin
 HasMajorGridlines := False;
 HasMinorGridlines := False;
 end;
 with (Axes(xlValue, xlPrimary, 1) as Axis) do
 begin
 MinimumScale := 500;
 HasMajorGridlines := True;
 HasMinorGridlines := False;
 end;
 (SeriesCollection(1, 1) as Series).Border.ColorIndex := 7;
 (SeriesCollection(1, 1) as Series).Border.Weight := xlMedium;
 end;
 //end;
 ExcelWorksheet1.Range['B' + IntToStr(ind_cell+16), EmptyParam].Value := 'Время прогрева = ' + FloatToStr(intervals[i]) + ' c';
 ExcelWorksheet1.Range['B' + IntToStr(ind_cell+16), 'F' + IntToStr(ind_cell+16)].MergeCells := False;
 ExcelWorksheet1.Range['B' + IntToStr(ind_cell+16), 'G' + IntToStr(ind_cell+16)].Merge(EmptyParam);
 N_zagot := N_zagot + 1;
 ind_cell := ind_cell + 17;
 end;
 ExcelWorksheet1.PageSetup.CenterHeader := 'Контрольный график температур при изготовлении партии деталей ' + DateToStr(DateTimePicker1.Date) + ' №________________';
 // Делаем Excel видимым
 ExcelApplication1.Visible[1] := True;
end; //open_excel=true
Это такая сборная солянка из того, что я нашла в инете, вычитала из книг и узнала с помощью макросов excel. Но должна сказать - не все макросы работают при переводе их в Object Pascal
не все макросы работают при переводе их в Object Pascal
Например... ?
Например:
Код макроса на VB
Изменение высоты конкретной строки
Rows("4:4").RowHeight = 46.5
И так это выглядит на OP:
ExcelWorksheet1.Range['A' + IntToStr(ind_cell+1), EmptyParam].Select;
Range1 := ExcelRange(ExcelApplication1.Selection[0]);
Range1.RowHeight := 60;
И еще изменение Font колонтитулов
На VB
 With ActiveSheet.PageSetup
 .CenterHeader = "&""Times New Roman,полужирный""&16Колонтитул"
 End With
А на OP так не получается, а как именно делать, я еще не додумалась
Попробуй так:
XLApp.WorkBooks[1].WorkSheets[i].Rows[k].RowHeight := 25;
Source: Взято из http://forum.sources.ru
ID: 04401
Category:COM
Category:MS Office