Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
МУ_КР_ПСЭД_ок.doc
Скачиваний:
2
Добавлен:
24.08.2019
Размер:
1.61 Mб
Скачать

Пример взаимодействия с ms Excel

// ======================= Пример использования технологии OLE-Automation в MS Excel =======================

// ================== Работа с документами MSOffice через компоненты закладки "Servers" ====================

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, OleServer, ComObj, FileCtrl, ExtCtrls, WordXP,

PowerPointXP, OutlookXP, ExcelXP, DB, DBTables, Grids, DBGrids, OfficeXP;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

ExcelApplication1: TExcelApplication;

ExcelWorkbook1: TExcelWorkbook;

DBGrid1: TDBGrid;

Query1: TQuery;

DataSource1: TDataSource;

ExcelWorksheet1: TExcelWorksheet;

GroupBox1: TGroupBox;

Label3: TLabel;

Label2: TLabel;

StaticText2: TStaticText;

StaticText3: TStaticText;

ExcelChart1: TExcelChart;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure DBGrid1CellClick(Column: TColumn);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

// Razd,Word,doc,doc1,doc2,Doc_Pres,Doc_Pres1: OleVariant;

Lcid,ColColumns,ColRows,i,j,SRows,SColumns,max,NomClient:integer;

StrKomb :string;

doc1 :OleVariant;

implementation

{$R *.dfm}

//Активируем БД -------------------------------

procedure TForm1.Button1Click(Sender: TObject);

begin

Query1.Active:=true;//обращаемся к базе данных

end;

//-----------------------------------------------

//Закрыть ---------------------------------------

procedure TForm1.Button2Click(Sender: TObject);

begin

if ExcelApplication1 <> nil then

begin

ExcelApplication1.Disconnect;

ExcelApplication1.Quit;

end;

Form1.close;

end;

//----------------------------------------------

//Загрузка существующего файла --------------------------------------------------------------

procedure TForm1.Button3Click(Sender: TObject);

begin

//Загрузка существующего файла Excel

doc1:='G:\ДЛЯ СТУДЕНТОВ ТИЭИ\ПРОЕКТИРОВАНИЕ СИСТЕМ ЭЛЕКТРОННОГО ДОКУМЕНТООБОРОТА\ПРИЛ\3\pr1.xls'; //открыть существующий документ 1

ExcelApplication1.Workbooks.Open(doc1,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,Lcid); //открыть существующий документ 1

ExcelWorkbook1.ConnectTo(ExcelApplication1.ActiveWorkbook); //соединяем компонет ExcelWorkbook1 с активной книгой

ExcelWorksheet1.ConnectTo(ExcelApplication1.Worksheets.Item['Лист3'] as _Worksheet); //выбираем лист№3 книги

ExcelWorksheet1.Activate;//активируем лист

ExcelApplication1.Visible[Lcid]:=true; //показываем приложение полностью

//РАБОТАЕМ НА ЛИСТЕ №3 --------------------------------------------------------------

ColRows:=Query1.RecordCount+1;//задаем кол-во строк будущей таблицы Word

ColColumns:=Query1.FieldCount; //задаем кол-во столбцов будущей таблицы Word

//Сдвиг позиции отображения по отношению к началу координат

SRows:=2;

SColumns:=3;

//Имена полей - на лист Excel --------------------------------------------------------

for j:=0 to ColColumns-1 do

begin

ExcelWorksheet1.Cells.Item[1+SRows,j+SColumns].value:=Query1.Fields[j].DisplayName;

end;

//-----------------------------------------------------------------------------------

//Авторазмер столбцов по ширине значений ячеек (кол-во символов в строке Length) ---------------------------------------------

max:=0;

for j:=0 to ColColumns-1 do

begin

Query1.First; //Выборка - на первую запись

max:=Length(Query1.Fields[j].AsString);

for i:=1 to ColRows do

begin

if (max<=Length(Query1.Fields[j].AsString)) then max:=Length(Query1.Fields[j].AsString);

Query1.Next; //Выборка - на одну запись вниз

end;

//сравниваем ширину не только по домену данных но и по заголовку таблицы

if (max<=Length(Query1.Fields[j].DisplayName)) then max:=Length(Query1.Fields[j].DisplayName);

ExcelWorksheet1.Cells.Item[i+SRows,j+SColumns].ColumnWidth:=max;

end;

//------------------------------------------------------------------------------------------

Query1.First; //Выборка - на первую запись

//Значения домена - на лист Excel --------------------------------------------------------

for i:=1 to ColRows do

begin

for j:=0 to ColColumns-1 do

begin

if i < ColRows then ExcelWorksheet1.Cells.Item[i+SRows+1,j+SColumns].value:=Query1.Fields[j].AsString;//вставляем значения не с первой позиции

end;

Query1.Next; //Выборка - на следующую запись

end;

//-----------------------------------------------------------------------------------

//Заголовок таблицы -----------------------------------------------------------------

//объединяем ячейки ---------------------------------------------------

ExcelWorksheet1.Cells.Range[ExcelWorksheet1.Cells.Item[SRows-1,SColumns],

ExcelWorksheet1.Cells.Item[SRows-1,ColColumns+2]].MergeCells:=true;

//---------------------------------------------------------------------

//Форматируем шрифт ---------------------------------------------------

ExcelWorksheet1.Cells.Item[SRows-1,SColumns].font.color:=clGreen; //цвет

ExcelWorksheet1.Cells.Item[SRows-1,SColumns].font.Bold:=1; //стиль

ExcelWorksheet1.Cells.Item[SRows-1,SColumns].font.Italic:=1; //стиль

//---------------------------------------------------------------------

ExcelWorksheet1.Cells.Item[SRows-1,SColumns].HorizontalAlignment:=xlVAlignCenter; //выравнивание по горизонтали - центр

ExcelWorksheet1.Cells.Item[SRows-1,SColumns].VerticalAlignment:=xlHAlignCenter; //выравнивание по вертикали - центр

ExcelWorksheet1.Cells.Item[SRows-1,SColumns].value:='СПРАВОЧНАЯ ТАБЛИЦА'; //пишем заголовок

//-----------------------------------------------------------------------------------

//Размечаем границы таблицы ---------------------------------------------------------

//Внешняя граница - толще

ExcelWorksheet1.Cells.Range[ExcelWorksheet1.Cells.Item[1+SRows,SColumns],

ExcelWorksheet1.Cells.Item[ColRows+SRows,ColColumns+SColumns-1]].BorderAround(1,4,1,EmptyParam);

//Вертикальная граница

//Цвет линий - базовый красный

ExcelWorksheet1.Cells.Range[ExcelWorksheet1.Cells.Item[1+SRows,SColumns],

ExcelWorksheet1.Cells.Item[ColRows+SRows,ColColumns+SColumns-1]].Borders.Item[11].color:=clRed;

ExcelWorksheet1.Cells.Range[ExcelWorksheet1.Cells.Item[1+SRows,SColumns],

ExcelWorksheet1.Cells.Item[ColRows+SRows,ColColumns+SColumns-1]].Borders.Item[11].LineStyle:=1;

//Горизонтальная граница

ExcelWorksheet1.Cells.Range[ExcelWorksheet1.Cells.Item[1+SRows,SColumns],

ExcelWorksheet1.Cells.Item[ColRows+SRows,ColColumns+SColumns-1]].Borders.Item[12].color:=clRed;

ExcelWorksheet1.Cells.Range[ExcelWorksheet1.Cells.Item[1+SRows,SColumns],

ExcelWorksheet1.Cells.Item[ColRows+SRows,ColColumns+SColumns-1]].Borders.Item[12].LineStyle:=1;

//-----------------------------------------------------------------------------------

// Создаем лист - диаграмму ---------------------------------------------------------

//Замечание. Закомментированные строки в этом блоке - вариант управления диаграммой через связку ExcelApplication1.ActiveChart

//(без компонента ExcelChart1) - для активации - "раскоментировать", а строки с ExcelChart1 - наоборот "заскоментировать"!!!

ExcelApplication1.Charts.Add(EmptyParam,EmptyParam,1,EmptyParam,1); //добавляем диаграмму в коллекцию диаграмм

//ExcelWorksheet1.InsertComponent(ExcelChart1);

ExcelChart1.ConnectTo(ExcelApplication1.ActiveChart); //соединяем компонент ExcelChart1 с диаграммой

ExcelChart1.type_[1]:=xl3DPie; //Выбираем тип диаграммы - круговая объемная диаграмма

//ExcelApplication1.ActiveChart.type_[1]:=xl3DPie; // то же самое без ExcelChart1

ExcelApplication1.ActiveChart.SeriesCollection(EmptyParam,1); //добавляем новый график в диаграмму

ExcelApplication1.ActiveChart.Name:='Диаграмма'; //даем название листу с диаграммоу

ExcelApplication1.ActiveChart.HasLegend[1]; //показываем "легенду" диаграммы

ExcelChart1.SetSourceData(ExcelWorksheet1.Range['I4','I10']); // числовые дынные из справочной таблицы для построения

//ExcelApplication1.ActiveChart.SetSourceData(ExcelWorksheet1.Range['I4','I10'],0); // то же самое без ExcelChart1

ExcelChart1.Activate; //активируем диаграмму

//ExcelApplication1.ActiveChart.Activate(1); // то же самое без ExcelChart1

ExcelChart1.Visible[1]; //показываеи диаграмму на экране

//ExcelApplication1.ActiveChart.Visible[1]; // то же самое без ExcelChart1

//-----------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------

//РАБОТАЕМ НА ЛИСТЕ №2 --------------------------------------------------------------

Query1.First; //Выборка - на первую запись

Query1.MoveBy(NomClient-1); //формируем документ для выбранной записи

ExcelWorksheet1.ConnectTo(ExcelApplication1.Worksheets.Item['Лист2'] as _Worksheet); //выбираем лист№2 книги

ExcelWorksheet1.Activate;//активируем лист

ExcelApplication1.Visible[Lcid]:=true; //показываем приложение полностью

// Вводим текст документа ----------------------------------------------------

//Первое предложение "шапки" -----------

with ExcelWorksheet1.Range['G1','J1'] do

begin

VerticalAlignment:=xlVAlignCenter; //выравнивание вертикальное - по центру

HorizontalAlignment:=xlHAlignRight; //выравнивание горизонтальное - по центру

MergeCells:=true; //объединение ячеек

Value[EmptyParam]:='Для представления'; //пишем текст

end;

//---------------------------------------

//Второе предложение "шапки" -----------

with ExcelWorksheet1.Range['G2','J2'] do

begin

VerticalAlignment:=xlVAlignCenter; //выравнивание вертикальное - по центру

HorizontalAlignment:=xlHAlignRight; //выравнивание горизонтальное - по центру

MergeCells:=true; //объединение ячеек

Value[EmptyParam]:='по месту требования'; //пишем текст

end;

//---------------------------------------

//Печатаем текст - Cправка ---

with ExcelWorksheet1.Range['E6','F6'] do

begin

VerticalAlignment:=xlVAlignCenter; //выравнивание вертикальное - по центру

HorizontalAlignment:=xlHAlignRight; //выравнивание горизонтальное - по центру

MergeCells:=true; //объединение ячеек

font.Bold:=1; //шрифт - стиль

font.Italic:=1; //шрифт - стиль

Value[EmptyParam]:='С П Р А В К А'; //пишем текст

end;

//Печатаем текст после слова справка ----------------------------------------------------------------------

StrKomb:='Гражданин ' + Query1.FieldByName('FIO').Asstring + ' '+ Query1.FieldByName('GODR').Asstring +

' года рождения работает в '+ Query1.FieldByName('FIRMA').Asstring+ ' , подразделение';

ExcelWorksheet1.Cells.Item[10,1].value:= StrKomb;

StrKomb:= '" '+ Query1.FieldByName('PODR').Asstring + ' ", в должности " ' + Query1.FieldByName('DOLGN').Asstring + ' ", c '+

Query1.FieldByName('DATEN').Asstring+' по настоящее время.';

ExcelWorksheet1.Cells.Item[12,1].value:= StrKomb;

StrKomb:= 'Нач. отдела кадров ________________ '+Query1.FieldByName('BOSSOK').Asstring;

//Форматируем область подписи начальника отдела кадров ----------------------------------

with ExcelWorksheet1.Range['E17','J17'] do

begin

VerticalAlignment:=xlVAlignCenter; //выравнивание вертикальное - по центру

HorizontalAlignment:=xlHAlignRight; //выравнивание горизонтальное - по центру

MergeCells:=true; //объединение ячеек

font.Bold:=1; //шрифт - стиль

font.Italic:=1; //шрифт - стиль

Value[EmptyParam]:=StrKomb;; //пишем текст

end;

//-----------------------------------------------------------------------------------

//--------------------------------------------------------------------------------------

ExcelWorksheet1.Range['A1','J18'].BorderAround(2,4,1,EmptyParam);// рамка - граница сформированного документа

//Форматируем лист Excel ----------------------------------------

with ExcelWorksheet1.PageSetup do

begin

ExcelWorksheet1.PageSetup.PaperSize:=DMPAPER_A4;//формат - А4

ExcelWorksheet1.PageSetup.LeftMargin:=20; //поле левое

ExcelWorksheet1.PageSetup.RightMargin:=20; //поле правое

ExcelWorksheet1.PageSetup.TopMargin:=20; //поле верхнее

ExcelWorksheet1.PageSetup.BottomMargin:=20; //поле нижнее

end;

//---------------------------------------------------------------

//-----------------------------------------------------------------------------------

end;

//-----------------------------------------------------------------------------------

//end;

//Завершение приложения --------------------------------------------------

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if ExcelApplication1 <> nil then

begin

ExcelApplication1.Disconnect;

ExcelApplication1.Quit;

end;

end;

//-------------------------------------------------------------------------

//Выбор текущей записи в БД ------------------------------------------------

procedure TForm1.DBGrid1CellClick(Column: TColumn);

begin

StaticText2.Caption:= Query1.fieldbyname('FIO').AsString; //Показываем краткое содержание текущей записи

StaticText3.Caption:= Query1.fieldbyname('NOM').AsString; //Показываем краткое содержание текущей записи

NomClient:=Query1.RecNo; //фиксируем номер текущей записи для последующей работы

end;

//-------------------------------------------------------------------------

end.

//============================================================================

Примечание.

Иногда Delphi не обнаруживает на «своих местах» специализированные библиотеки, указанные в разделе USES в модуле программы (Unit): WordXP, PowerPointXP, OutlookXP, ExcelXP, OfficeXP и другие (в файлах .dcu и .pas). При отсутствии их нужно найти и скопировать по путям:

1. файлы .dcuC:\Program Files\Borland\Delphi7\Lib

2. файлы .pasC:\Program Files\Borland\Delphi7\Ocx\Servers

Иногда файлы .pas, находящиеся по пути C:\Program Files\Borland\Delphi7\Ocx\Servers все равно не обнаруживаются, о чем говорят соответствующие диагностические сообщения Delphi. В этом случае поможет копирование соответствующих файлов .pas по пути: C:\Program Files\Borland\Delphi7\Lib.

ПРИЛОЖЕНИЕ 8