![]() |
![]() ![]() ![]() ![]() ![]() |
![]() |
Работа с MSExcelDelphi , Технологии , OLE Automation MSOffice
Автор: Daun { **** 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 обеспечивает функциональность для работы с Microsoft Excel. Единица содержит несколько процедур и функций для взаимодействия с Excel, такие как:
Единица также содержит некоторые константы и переменные, такие как Вот подробное описание работы кода:
Код также включает в себя обработку ошибок, используя блок Это единица является примером использования поддержки COM Delphi для взаимодействия с приложениями Microsoft Office из вашего программы на Delphi. Работа с MSExcel - утилита для автоматизации процессов в Microsoft Excel из Delphi. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: OLE Automation MSOffice ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |