Delphi World - Работа с MSExcel
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Работа с MSExcel

Автор: Daun
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Работа с MS Excel

Основная функция - передача данных из DataSet в Excel

Зависимости: ComObj, QDialogs, SysUtils, Variants, DB
Автор:       Daun, daun@mail.kz
Copyright:   daun
Дата:        5 октября 2002 г.
***************************************************** }

unit ExcelModule;

interface

uses ComObj, QDialogs, SysUtils, Variants, DB;

//**=====================================================
//** MS Excel
//**=====================================================

//** Открытие Excel
procedure ExcelCreateApplication(FirstSheetName: string; //назв-е 1ого листа
  SheetCount: Integer; //кол-во листов
  ExcelVisible: Boolean); //отображение книги

//** Перевод номера столбца в букву, напр. 1='A',2='B',..,28='AB'
//** Должно работать до 'ZZ'
function ExcelChar(Num: Integer): string;

//** Оформление указанного диапазона бордерами
procedure ExcelRangeBorders(RangeBorders: Variant; //диапазон
  BOutSideSize: Byte; //толщина снаружи
  BInsideSize: Byte; //толщина внутри
  BOutSideVerticalLeft: Boolean;
  BOutSideVerticalRight: Boolean;
  BInSideVertical: Boolean;
  BOutSideHorizUp: Boolean;
  BOutSideHorizDown: Boolean;
  BInSideHoriz: Boolean);

//** Форматирование диапазона (шрифт, размер)
procedure ExcelFormatRange(RangeFormat: Variant;
  Font: string;
  Size: Byte;
  AutoFit: Boolean);
//** Вывод DataSet
procedure ExcelGetDataSet(DataSet: TDataSet;
  SheetNumber: Integer; // Номер листа
  FirstRow: Integer; // Первая строка
  FirstCol: Integer; // Первый столбец
  ShowCaptions: Boolean; // Вывод заголовков DataSet
  ShowNumbers: Boolean; // Вывод номеров (N пп)
  FirstNumber: Integer; // Первый номер
  ShowBorders: Boolean; // Вывод бордюра
  StepCol: Byte; // Шаг колонок: 0-подряд,
  // 1-через одну и тд
  StepRow: Byte); // Шаг строк

//** Меняет имя листа
procedure ExcelSetSheetName(SheetNumber: Byte; //номер листа
  SheetName: string); //имя
//** Делает Excel видимым
procedure ExcelShow;

//** Сохранение книги
procedure ExcelSaveWorkBook(Name: string);

//**=====================================================
//** MS Word
//**=====================================================

//** Открытие Ворда
procedure CreateWordAppl(WordVisible: Boolean);

//** Отображение Ворда
procedure MakeWordVisible;

//** Набор текста
procedure WordTypeText(s: string);

//** Новый параграф
procedure NewParag(Bold: Boolean;
  Italic: Boolean;
  ULine: Boolean;
  Alignment: Integer;
  FontSize: Integer);

var
  Excel, Sheet, Range, Columns: Variant;

  MSWord, Selection: Variant;

implementation

procedure ExcelCreateApplication(FirstSheetName: string;
  SheetCount: Integer;
  ExcelVisible: Boolean);
begin
  try
    Excel := CreateOleObject('Excel.Application');
    Excel.Application.EnableEvents := False;
    Excel.DisplayAlerts := False;
    Excel.SheetsInNewWorkbook := SheetCount;
    Excel.Visible := ExcelVisible;
    Excel.WorkBooks.Add;
    Sheet := Excel.WorkBooks[1].Sheets[1];
    Sheet.Name := FirstSheetName;
  except
    Exception.Create('Error.');
    Excel := UnAssigned;
  end;
end;

function ExcelChar(Num: Integer): string;
var
  S: string;
  I: Integer;
begin
  I := Trunc(Num / 26);
  if Num > 26 then
    S := Chr(I + 64) + Chr(Num - (I * 26) + 64)
  else
    S := Chr(Num + 64);
  Result := S;
end;

procedure ExcelRangeBorders(RangeBorders: Variant;
  BOutSideSize: Byte;
  BInsideSize: Byte;
  BOutSideVerticalLeft: Boolean;
  BOutSideVerticalRight: Boolean;
  BInSideVertical: Boolean;
  BOutSideHorizUp: Boolean;
  BOutSideHorizDown: Boolean;
  BInSideHoriz: Boolean);
begin
  if BOutSideVerticalLeft then
  begin
    RangeBorders.Borders[7].LineStyle := 1;
    RangeBorders.Borders[7].Weight := BOutSideSize;
    RangeBorders.Borders[7].ColorIndex := -4105;
  end;
  if BOutSideHorizUp then
  begin
    RangeBorders.Borders[8].LineStyle := 1;
    RangeBorders.Borders[8].Weight := BOutSideSize;
    RangeBorders.Borders[8].ColorIndex := -4105;
  end;
  if BOutSideHorizDown then
  begin
    RangeBorders.Borders[9].LineStyle := 1;
    RangeBorders.Borders[9].Weight := BOutSideSize;
    RangeBorders.Borders[9].ColorIndex := -4105;
  end;
  if BOutSideVerticalRight then
  begin
    RangeBorders.Borders[10].LineStyle := 1;
    RangeBorders.Borders[10].Weight := BOutSideSize;
    RangeBorders.Borders[10].ColorIndex := -4105;
  end;
  if BInSideVertical then
  begin
    RangeBorders.Borders[11].LineStyle := 1;
    RangeBorders.Borders[11].Weight := BInSideSize;
    RangeBorders.Borders[11].ColorIndex := -4105;
  end;
  if BInsideHoriz then
  begin
    RangeBorders.Borders[12].LineStyle := 1;
    RangeBorders.Borders[12].Weight := BInSideSize;
    RangeBorders.Borders[12].ColorIndex := -4105;
  end;
end;

procedure ExcelFormatRange(RangeFormat: Variant;
  Font: string;
  Size: Byte;
  AutoFit: Boolean);
begin
  RangeFormat.Font.Name := 'Arial';
  RangeFormat.Font.Size := 7;
  if AutoFit then
    RangeFormat.Columns.AutoFit;
end;

procedure ExcelSetSheetName(SheetNumber: Byte;
  SheetName: string);
begin
  try
    Sheet := Excel.WorkBooks[1].Sheets[SheetNumber];
    Sheet.Name := SheetName;
  except
    Exception.Create('Error.');
    Exit;
  end;
end;

procedure ExcelShow;
begin
  Excel.Visible := True;
  Excel := UnAssigned;
end;

procedure ExcelGetDataSet(DataSet: TDataSet;
  SheetNumber: Integer;
  FirstRow: Integer;
  FirstCol: Integer;
  ShowCaptions: Boolean;
  ShowNumbers: Boolean;
  FirstNumber: Integer;
  ShowBorders: Boolean;
  StepCol: Byte;
  StepRow: Byte);
var
  Column: Integer;
  Row: Integer;
  I: Integer;
begin
  if (ShowCaptions) and (FirstRow < 2) then
    FirstRow := 2;
  if (ShowNumbers) and (FirstCol < 2) then
    FirstCol := 2;

  try
    Sheet := Excel.WorkBooks[1].Sheets[SheetNumber];
  except
    Exception.Create('Error.');
    Exit;
  end;

  try
    with DataSet do
    try
      DisableControls;

      if ShowCaptions then
      begin
        Row := FirstRow - 1;
        Column := FirstCol;
        for i := 0 to FieldCount - 1 do
          if Fields[i].Visible then
          begin
            Sheet.Cells[Row, Column] := Fields[i].DisplayName;
            Inc(Column);
          end;
        Sheet.Rows[Row].Font.Bold := True;
      end;

      Row := FirstRow;
      First;
      while not EOF do
      begin
        Column := FirstCol;
        if ShowNumbers then
          Sheet.Cells[Row, FirstCol - 1] := FirstNumber;

        for i := 0 to FieldCount - 1 do
        begin
          if Fields[i].Visible then
          begin
            if Fields[i].DataType <> ftfloat then
              Sheet.Cells[Row, Column] := Trim(Fields[i].DisplayText)
            else
              Sheet.Cells[Row, Column] := Fields[i].Value;
            Inc(Column, StepCol);
          end;
        end;
        Inc(Row, StepRow);
        Inc(FirstNumber);
        Next;
      end;

      if ShowBorders then
      begin
        if ShowCaptions then
          Dec(FirstRow);
        if ShowNumbers then
          FirstCol := FirstCol - 1;
        Range := Sheet.Range[ExcelChar(FirstCol) + IntToStr(FirstRow) +
          ':' + ExcelChar(Column - 1) + IntToStr(Row - 1)];
        if (Row - FirstRow) < 2 then
          ExcelRangeBorders(Range, 3, 2, True, True,
            True, True, True, False)
        else
          ExcelRangeBorders(Range, 3, 2, True, True,
            True, True, True, True);
        ExcelFormatRange(Range, 'Arial', 7, True);
      end;

    finally
      EnableControls;
    end;
  finally
  end;
end;

procedure ExcelSaveWorkBook(Name: string);
begin
  Excel.ActiveWorkbook.SaveAs(Name);
end;

procedure CreateWordAppl(WordVisible: Boolean);
begin
  try
    MsWord := GetActiveOleObject('Word.Application');
    MSWord.Documents.Add;
  except
    try
      MsWord := CreateOleObject('Word.Application');
      MsWord.Visible := WordVisible;
      MSWord.Documents.Add;
    except
      Exception.Create('Error.');
      MSWord := Unassigned;
    end;
  end;
end;

procedure MakeWordVisible;
begin
  MsWord.Visible := True;
  MSWord := Unassigned;
end;

procedure WordTypeText(S: string);
begin
  MSWord.Selection.TypeText(S);
end;

procedure NewParag(Bold: Boolean;
  Italic: Boolean;
  ULine: Boolean;
  Alignment: Integer;
  FontSize: Integer);
begin
  MsWord.Selection.TypeParagraph;
  MSWord.Selection.ParagraphFormat.Alignment := Alignment;
  MSWord.Selection.Font.Bold := Bold;
  MSWord.Selection.Font.Italic := Italic;
  MSWord.Selection.Font.UnderLine := ULine;
  MSWord.Selection.Font.Size := FontSize;
end;

end.

// Пример использования:

unit Example;
...
uses..., ExcelModule;
...

procedure Tform1.Button1.Click(Sender: TObject);
begin
  Query1.SQL.Text := 'select * from Table';
  Query1.Open;
  ExcelCreateApplication('Example', 1, True);
  ExcelGetDataSet(Query1, 1, 1, 1, True, True, 1, True, 1, 1);
  ExcelShow;
end;
...
end.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования