Шаг 145.
Автоматизация Microsoft Excel. Работа с ячейками.
Шрифт

    На этом шаге мы рассмотрим задание шрифта.

    Важным свойством текста в Excel является шрифт отображаемых значений ячеек и текста других объектов. Для ячеек шрифт является одним из свойств объекта Range, при этом в одной ячейке не может быть, например, два фрагмента текста с разным шрифтом. Шрифт определяется свойством Font ячейки или области ячеек. Шрифт по существу тоже является объектом со своими свойствами, определяющими те или иные характеристики отображения текста. Свойства объекта Font и их характеристика представлены в таблице 1.

Таблица 1. Свойства объекта Font
Свойство Тип Значение
Name String Имя
Background Integer Стиль прорисовки фона (используется только для диаграмм)
FontStyle String Строковое описание стиля
Bold Boolean Полужирный
Italic Boolean Курсив
Size Integer Размер шрифта
Strikethrough Boolean Зачеркнутый
Superscript Boolean Верхний индекс
Subscript Boolean Нижний индекс
OutlineFont Boolean Не используется
Shadow Boolean He используется
Underline Integer Подчеркивание
ColorIndex Integer Индекс цвета из палитры цветов
Color Integer Цвет

    Программистов Delphi в первую очередь будет интересовать, каким образом шрифт стандартных объектов разрабатываемых приложений может соответствовать объекту Font, принадлежащему объекту Excel.Application и подчиненным объектам. Иными словами - как управлять шрифтом создаваемых документов в Excel из приложений. В Delphi свойства шрифта несколько отличаются от свойств шрифта в Excel, поэтому чтобы решить проблему согласования, достаточно написать небольшую процедуру, преобразующую свойства шрифта Delphi в свойства шрифта Excel. Вот пример такой процедуры. 

function SetFontRange(R:variant; font:TFont):Boolean;
//Выбор шрифта для текста ячейки
const
  xlUnderlineStyleNone=-4142;
  xlUnderlineStyleSingle=2;
begin
  SetFontRange:=True;
  try
    R.Font.Name:=font.Name;
    if fsBold in font.Style then
       R.Font.Bold:=True
    else
       R.Font.Bold:=False;
    if fsItalic in font.Style then
       R.Font.Italic:=True
    else
       R.Font.Italic:=False;
    R.Font.Size:=font.Size;
    if fsStrikeOut in font.Style then
       R.Font.Strikethrough:=True
    else
       R.Font.Strikethrough:=False;
    if fsUnderline in font.Style then
       R.Font.Underline:=xlUnderlineStyleSingle
    else
       R.Font.Underline:=xlUnderlineStyleNone;
    R.Font.Color:=font.Color;
  except
    SetFontRange:=false;
  end;
end;

    На рисунке 1 видно изменение шрифта ячейки, полученное с помощью представленного программного кода.


Рис.1. Настройка шрифта

    Приведем полный текст приложения. 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    ComboBox1: TComboBox;
    Label3: TLabel;
    ComboBox2: TComboBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    Label4: TLabel;
    SpinEdit1: TSpinEdit;
    Button3: TButton;
    CheckBox3: TCheckBox;
    Button4: TButton;
    FontDialog1: TFontDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
  E:variant;
  Range:variant;

{$R *.dfm}

function SetFontRange(R:variant; font:TFont):Boolean;
//Выбор шрифта для текста ячейки
const
  xlUnderlineStyleNone=-4142;
  xlUnderlineStyleSingle=2;
begin
  SetFontRange:=True;
  try
    R.Font.Name:=font.Name;
    if fsBold in font.Style then
       R.Font.Bold:=True
    else
       R.Font.Bold:=False;
    if fsItalic in font.Style then
       R.Font.Italic:=True
    else
       R.Font.Italic:=False;
    R.Font.Size:=font.Size;
    if fsStrikeOut in font.Style then
       R.Font.Strikethrough:=True
    else
       R.Font.Strikethrough:=False;
    if fsUnderline in font.Style then
       R.Font.Underline:=xlUnderlineStyleSingle
    else
       R.Font.Underline:=xlUnderlineStyleNone;
    R.Font.Color:=font.Color;
  except
    SetFontRange:=false;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
//Создание объекта Excel и отображение окна
begin
  E:=CreateOleObject('Excel.Application');
  E.Visible:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
//Создание рабочей книги
begin
  E.WorkBooks.Add;
end;

procedure TForm1.Edit1Exit(Sender: TObject);
//Определение области
begin
 Range:=E.ActiveSheet.Range[Edit1.Text];
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
//Задание горизонтального выравнивания
begin
  case ComboBox1.ItemIndex of
    0: Range.HorizontalAlignment:=-4108; //xlHAlignCenter
    1: Range.HorizontalAlignment:=7;     //xlHAlignCenterAcrossSelection
    2: Range.HorizontalAlignment:=-4117; //xlHAlignDistributed
    3: Range.HorizontalAlignment:=5;     //xlHAlignFill
    4: Range.HorizontalAlignment:=1;     //xlHAlignGeneral
    5: Range.HorizontalAlignment:=-4130; //xlHAlignJustify
    6: Range.HorizontalAlignment:=-4131; //xlHAlignLeft
    7: Range.HorizontalAlignment:=-4152; //xlHAlignRight
  end;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
//Задание вертикального выравнивания
begin
  case ComboBox2.ItemIndex of
    0: Range.VerticalAlignment:=-4107; //xlHAlignRight
    1: Range.VerticalAlignment:=-4108; //xlVAlignCenter
    2: Range.VerticalAlignment:=-4117; //xlVAlignDistributed
    3: Range.VerticalAlignment:=-4130; //xlVAlignJustify
    4: Range.VerticalAlignment:=-4160; //xlVAlignTop
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
//Включение/отключение переноса по словам
begin
  Range.WrapText:=CheckBox1.Checked;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
//Включение/отключение автоподбора ширины
begin
  Range.ShrinkToFit:=CheckBox2.Checked;
end;

procedure TForm1.Button3Click(Sender: TObject);
//Задание поворота
begin
   Range.Orientation:=SpinEdit1.Value;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
//Объединение ячеек
begin
   Range.MergeCells:=CheckBox3.Checked;
end;

procedure TForm1.Button4Click(Sender: TObject);
//Выбор шрифта
begin
   if FontDialog1.Execute then
     SetFontRange(Range,FontDialog1.Font);
end;

end.
Текст этого приложения можно взять здесь (8,8 Кб).

    На следующем шаге мы рассмотрим границы ячейки.




Предыдущий шаг Содержание Следующий шаг