Некоторые функции для работы с MSWord и MSExcel



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

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Некоторые функции для работы с MSWord и MSExcel
Некоторые процедуры для работы с с MSWord и MSExcel,
которыми активно пользуюсь сам и предлагаю остальным.
Есть как простые функции такие как открытие документа,
получение текста документа, управление окнами и т.п.
так и более продвинутые: добавление таблицы в MSWord
или MSExcel из DBGrid, ListView и т.п. Описывать все
не буду, постарался чтобы из названия функций было понятно.
Зависимости: Windows, Messages, SysUtils, Classes,
Comctrls,Grids, DBGrids, WordConst, ExcelConst
Автор:       FalicSoft, [email protected], Москва
Copyright:   FalicSoft Laboratory (C)
Дата:        24 октября 2003 г.
***************************************************** }
unit ExcelConst;
interface
const
xlCenter = -4108;
xlLeft = -4131;
xlRight = -4152;
xlDistributed = -4117;
xlJustify = -4130;
xlNone = -4142;
{HorizontalAlignment}
xlHAlignCenter = -4108;
xlHAlignDistributed = -4117;
xlHAlignJustify = -4130;
xlHAlignLeft = -4131;
xlHAlignRight = -4152;
{In addition, for the Range or Style object}
xlHAlignCenterAcrossSelection = 7;
xlHAlignFill = 5;
xlHAlignGeneral = 1;
{VerticalAlignment}
xlVAlignBottom = -4107;
xlVAlignCenter = -4108;
xlVAlignDistributed = -4117;
xlVAlignJustify = -4130;
xlVAlignTop = -4160;
{Borders}
xlInsideHorizontal = 12;
xlInsideVertical = 11;
xlDiagonalDown = 5;
xlDiagonalUp = 6;
xlEdgeBottom = 9;
xlEdgeLeft = 7;
xlEdgeRight = 10;
xlEdgeTop = 8;
{LineStyle}
xlContinuous = 1;
xlDash = -4115;
xlDashDot = 4;
xlDashDotDot = 5;
xlDot = -4118;
xlDouble = -4119;
xlSlantDashDot = 13;
xlLineStyleNone = -4142;
{Weight}
xlHairline = 1;
xlThin = 2;
xlMedium = -4138;
xlThick = 4;
{ColorIndex}
xlColorIndexAutomatic = -4105;
xlColorIndexNone = -4142;
{Background}
xlBackgroundAutomatic = -4105;
xlBackgroundOpaque = 3;
xlBackgroundTransparent = 2;
{Underline}
xlUnderlineStyleNone = -4142;
xlUnderlineStyleSingle = 2;
xlUnderlineStyleDouble = -4119;
xlUnderlineStyleSingleAccounting = 4;
xlUnderlineStyleDoubleAccounting = 5;
implementation
end.
unit WordConst;
interface
const
{----MoveRight(Unit, Count, Extend)}
{Unit}
wdCharacter = 1;
wdWord = 2;
wdSentence = 3;
wdCell = 12;
wdAdjustNone = 0;
wdOrientPortrait = 0;
wdOrientLandScape = 1;
wdAlignParagraphCenter = 1;
wdAlignParagraphLeft = 0;
wdAlignParagraphRight = 2;
{Extend}
wdMove = 0;
wdExtend = 1;
wdBorderHorizontal = -6;
wdBorderVertical = -5;
wdLineStyleNone = 0;
wdLine = 5;
implementation
end.
unit FunctionOLEObject;
interface
uses
Windows, Messages, SysUtils, Classes,
Comctrls, Grids, DBGrids;
{---------- WORD ----------}
{--- Documents}
function WordAddDocument(const vWord: Variant;
const vTemplate: string;
const vNewTemplate: Boolean): Boolean;
{---Windows}
function WordWindowsCount(const vWord: Variant): Integer;
{---Window}
procedure WordWindowActivate(const vWord: Variant;
const IWindow: Integer);
procedure WordNextWindowActivate(const vWord: Variant);
procedure WordPreviousWindowActivate(const vWord: Variant);
{---Selection}
procedure WordPutField(const vWord: Variant;
const Field, Value: string);
procedure WordPutFieldItem(const vWord: Variant;
Field: string;
Item: Integer;
Value: array of string);
procedure WordText(const vWord: Variant;
const Value: string);
procedure WordTypeParagraph(const vWord: Variant);
procedure WordMoveRight(const vWord: Variant;
const vUnit, vCount, vExtend: Integer);
procedure WordMoveDown(const vWord: Variant;
const vUnit, vCount: integer);
{---Table}
procedure WordTablesAdd(const vWord: Variant;
const Rows, Columns: Integer);
procedure WordTablesHeaders(const vWord: Variant;
const vColl, vRow, vCount: integer);
procedure WordTablesCellValue(const vWord: Variant;
const Table, Row, Column: Integer;
const Value: string;
const FontName: string;
const FontBold, FontItalic: boolean;
const FontUnderLine: byte);
procedure WordTablesNextCellValue(const vWord: Variant;
const Value: string);
procedure WordTableAddFromListView(const vWord: Variant;
ListView: TListView);
procedure WordTableAddFromGrid(const vWord: Variant;
DBGrid: TDBGrid; CollSize: boolean);
{---------- Excel ----------}
procedure ExcelCellsValue(const vExcel: Variant;
const Row, Col: Integer;
const Value: Variant);
procedure ExcelFromListView(const vExcel: Variant;
ListView: TListView;
const Row, Col: Integer);
procedure ExcelTableAddFromGrid(const vExcel: Variant;
DBGrid: TDBGrid;
const Row, Col: Integer);
procedure ExcelRangeCellsValue(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Value: Variant;
const HorizontalAlignment,
VerticalAlignment: Integer;
const WrapText: Boolean;
const Orientation: Integer;
const ShrinkToFit: Boolean;
const MergeCells: Boolean);
procedure ExcelRangeCellsCopy(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const tlToRow, tlToCol,
drToRow, drToCol: Integer);
procedure ExcelRangeCellsBorders(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const BorderType: Integer;
const LineStyle: Integer);
procedure ExcelBorders(const vExcel: Variant;
const BorderType: Integer;
const LineStyle: Integer);
procedure ExcelRangeCellsSelect(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer);
procedure ExcelFont(const vExcel: Variant;
const Name: string;
const Bold: Boolean;
const Italic: Boolean;
const Size: Integer;
const Strikethrough: Boolean;
const Superscript: Boolean;
const Subscript: Boolean;
const OutlineFont: Boolean;
const Shadow: Boolean;
const Underline: Integer;
const ColorIndex: Integer);
procedure ExcelFontName(const vExcel: Variant;
const Name: string);
procedure ExcelFontSize(const vExcel: Variant;
const Size: Integer);
procedure ExcelFontBold(const vExcel: Variant;
const Bold: Boolean);
procedure ExcelFontItalic(const vExcel: Variant;
const Italic: Boolean);
procedure ExcelRangeCellsFontName(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Name: string);
procedure ExcelRangeCellsFontSize(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Size: Integer);
procedure ExcelRangeCellsFontBold(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Bold: Boolean);
procedure ExcelRangeCellsFontItalic(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Italic: Boolean);
procedure ExcelRangeCellsFont(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Name: string;
const Bold: Boolean;
const Italic: Boolean;
const Size: Integer;
const Strikethrough: Boolean;
const Superscript: Boolean;
const Subscript: Boolean;
const OutlineFont: Boolean;
const Shadow: Boolean;
const Underline: Integer;
const ColorIndex: Integer);
implementation
uses WordConst, ExcelConst;
function WordAddDocument(const vWord: Variant;
const vTemplate: string;
const vNewTemplate: Boolean): Boolean;
begin
Result := True;
try
vWord.Documents.Add(Template := vTemplate,
NewTemplate := vNewTemplate);
except
Result := False;
end;
end;
procedure WordMoveRight(const vWord: Variant;
const vUnit, vCount,
vExtend: Integer);
begin
vWord.Selection.MoveRight(vUnit, vCount, vExtend);
end;
procedure WordTablesHeaders(const vWord: Variant;
const vColl, vRow, vCount: integer);
var
I, cnt: integer;
begin
vWord.Selection.MoveLeft(unit := wdCell, Count := vColl - 1);
vWord.Selection.MoveUp(unit := wdLine, Count := vRow);
vWord.Selection.SelectRow;
vWord.Selection.Rows.HeadingFormat := -1;
{ vWord.Selection.MoveUp(Unit:=wdLine, Count:=vRow);
    vWord.Selection.Tables.Item(1).Select;
vWord.Selection.ParagraphFormat.Alignment:= wdAlignParagraphCenter;}
end;
procedure WordMoveDown(const vWord: Variant;
const vUnit, vCount: integer);
begin
vWord.Selection.MoveDown(vUnit, vCount);
end;
procedure WordTablesAdd(const vWord: Variant;
const Rows, Columns: Integer);
begin
vWord.ActiveDocument.Tables.Add(Range := vWord.Selection.Range,
NumRows := Rows, NumColumns := Columns);
end;
procedure WordTablesCellValue(const vWord: Variant;
const Table, Row, Column: Integer;
const Value: string;
const FontName: string;
const FontBold, FontItalic: boolean;
const FontUnderLine: byte);
begin
vWord.ActiveDocument.Tables.Item(Table).Cell(Row, Column).
Range.Font.Name := FontName;
vWord.ActiveDocument.Tables.Item(Table).Cell(Row, Column).
Range.Font.Bold := FontBold;
vWord.ActiveDocument.Tables.Item(Table).Cell(Row, Column).
Range.Font.Italic := FontItalic;
vWord.ActiveDocument.Tables.Item(Table).Cell(Row, Column).
Range.Font.UnderLine := FontUnderLine;
vWord.ActiveDocument.Tables.Item(Table).Cell(Row, Column).
Range.InsertAfter(Text := Value);
end;
procedure WordTableAddFromListView(const vWord: Variant;
ListView: TListView);
var
i, j: Integer;
begin
WordTablesAdd(vWord, ListView.Items.Count + 1, ListView.Columns.Count);
WordText(vWord, ListView.Column[0].Caption);
for j := 1 to ListView.Columns.Count - 1 do
begin
WordTablesNextCellValue(vWord,
ListView.Column[j].Caption);
end;
for i := 0 to ListView.Items.Count - 1 do
begin
WordTablesNextCellValue(vWord,
ListView.Items.Item[i].Caption);
for j := 0 to ListView.Columns.Count - 2 do
if ListView.Items.Item[i].SubItems.Count > j then
WordTablesNextCellValue(vWord,
ListView.Items.Item[i].SubItems.Strings[j])
else
WordMoveRight(vWord, wdCell, 1, wdMove);
end;
end;
procedure WordTableAddFromGrid(const vWord: Variant;
DBGrid: TDBGrid; CollSize: boolean);
var
i, j, Col, Row, ColWidth: Integer;
begin
Col := DBGrid.Columns.Count;
Row := DBGrid.DataSource.DataSet.RecordCount + 1;
WordTablesAdd(vWord, Row, Col);
WordText(vWord, DBGrid.Columns.Items[0].Title.Caption);
if CollSize then
ColWidth := DBGrid.Columns.Items[0].Width;
vWord.Selection.Tables.Item(1).Columns.Item(1).
SetWidth(ColumnWidth := ColWidth, RulerStyle := wdAdjustNone);
for j := 1 to Col - 1 do
begin
WordTablesNextCellValue(vWord,
DBGrid.Columns.Items[j].Title.Caption);
if CollSize then
ColWidth := DBGrid.Columns.Items[j].Width;
vWord.Selection.Tables.Item(1).Columns.Item(j + 1).
SetWidth(ColumnWidth := ColWidth, RulerStyle := wdAdjustNone);
end;
DBGrid.DataSource.DataSet.First;
for i := 1 to Row - 1 do
begin
for j := 0 to Col - 1 do
WordTablesNextCellValue(vWord,
DBGrid.Columns.Items[j].Field.AsString);
DBGrid.DataSource.DataSet.Next;
end;
DBGrid.DataSource.DataSet.First;
end;
procedure WordTablesNextCellValue(const vWord: Variant;
const Value: string);
begin
WordMoveRight(vWord, wdCell, 1, wdMove);
vWord.Selection.Font.Bold := false;
WordText(vWord, Value);
end;
procedure WordText(const vWord: Variant;
const Value: string);
begin
vWord.Selection.TypeText(Text := Value);
end;
procedure WordTypeParagraph(const vWord: Variant);
begin
vWord.Selection.TypeParagraph;
end;
procedure WordPutField(const vWord: Variant;
const Field, Value: string);
begin
vWord.Selection.goto(Name := Field);
vWord.Selection.TypeText(Text := Value);
end;
procedure WordPutFieldItem(const vWord: Variant;
Field: string;
Item: Integer;
Value: array of string);
var
i: Integer;
begin
Field := Format('%s%d', [Field, Item]);
vWord.Selection.goto(Name := Field);
for i := Low(Value) to High(Value) do
begin
vWord.Selection.TypeText(Text := Value[i]);
vWord.Selection.MoveRight;
end;
end;
procedure WordWindowActivate(const vWord: Variant;
const IWindow: Integer);
begin
vWord.Windows.Item(IWindow).Activate;
end;
procedure WordNextWindowActivate(const vWord: Variant);
begin
vWord.ActiveWindow.Next.Activate;
end;
procedure WordPreviousWindowActivate(const vWord: Variant);
begin
vWord.ActiveWindow.Previous.Activate;
end;
function WordWindowsCount(const vWord: Variant): Integer;
begin
Result := vWord.Windows.Count;
end;
//------- Exel --------------------
procedure ExcelCellsValue(const vExcel: Variant;
const Row, Col: Integer;
const Value: Variant);
var
sV: string;
iV: Integer;
dV: TDateTime;
begin
case TVarData(Value).VType of
varEmpty: ;
varNull: ;
varSmallint: ;
varInteger:
begin
iV := Value;
vExcel.Cells[Row, Col].Value := iV;
end;
varSingle: ;
varDouble: ;
varCurrency: ;
varDate:
begin
dV := Value;
vExcel.Cells[Row, Col].Value := dV;
end;
varOLEStr: ;
varDispatch: ;
varError: ;
varBoolean: ;
varUnknown: ;
varByte: ;
varString:
begin
sV := Value;
vExcel.Cells[Row, Col].Value := sV;
end;
varTypeMask: ;
varArray: ;
varByRef: ;
end;
end;
procedure ExcelFromListView(const vExcel: Variant;
ListView: TListView;
const Row, Col: Integer);
var
i, j: Integer;
begin
for j := 0 to ListView.Columns.Count - 1 do
begin
vExcel.Cells[Row, Col + j].Value := ListView.
Column[j].Caption;
end;
for i := 0 to ListView.Items.Count - 1 do
begin
vExcel.Cells[Row + 1 + i, Col].Value := ListView.
Items.Item[i].Caption;
for j := 0 to ListView.Items.Item[i].SubItems.Count - 1 do
try
vExcel.Cells[Row + 1 + i, Col + 1 + j].Value := StrToFloat(ListView.
Items.Item[i].SubItems.Strings[j]);
except
vExcel.Cells[Row + 1 + i, Col + 1 + j].Value := ListView.
Items.Item[i].SubItems.Strings[j];
end;
end;
end;
procedure ExcelTableAddFromGrid(const vExcel: Variant;
DBGrid: TDBGrid;
const Row, Col: Integer);
var
i, j, vCol, vRow, ColWidth: Integer;
begin
vCol := DBGrid.Columns.Count;
vRow := DBGrid.DataSource.DataSet.RecordCount + 1;
for j := 0 to vCol - 1 do
vExcel.Cells[Row, Col + j].Value := DBGrid.Columns.Items[j].Title.Caption;
DBGrid.DataSource.DataSet.First;
for i := 0 to vRow - 2 do
begin
for j := 0 to vCol - 1 do
try
vExcel.Cells[Row + 1 + i, Col + j].Value :=
StrToFloat(DBGrid.Columns.Items[j].Field.AsString);
except
vExcel.Cells[Row + 1 + i, Col + j].Value :=
DBGrid.Columns.Items[j].Field.AsString;
end;
DBGrid.DataSource.DataSet.Next;
end;
DBGrid.DataSource.DataSet.First;
end;
procedure ExcelRangeCellsValue(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Value: Variant;
const HorizontalAlignment,
VerticalAlignment: Integer;
const WrapText: Boolean;
const Orientation: Integer;
const ShrinkToFit: Boolean;
const MergeCells: Boolean);
begin
ExcelCellsValue(vExcel, tlRow, tlCol, Value);
vExcel.Range[vExcel.Cells[tlRow, tlCol],
vExcel.Cells[drRow, drCol]].Select;
vExcel.Selection.HorizontalAlignment := HorizontalAlignment;
vExcel.Selection.VerticalAlignment := VerticalAlignment;
vExcel.Selection.WrapText := WrapText;
vExcel.Selection.Orientation := Orientation;
vExcel.Selection.ShrinkToFit := ShrinkToFit;
vExcel.Selection.MergeCells := MergeCells;
end;
procedure ExcelRangeCellsCopy(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const tlToRow, tlToCol,
drToRow, drToCol: Integer);
begin
vExcel.Range[vExcel.Cells[tlRow, tlCol],
vExcel.Cells[drRow, drCol]].Select;
vExcel.Selection.Copy;
vExcel.Range[vExcel.Cells[tlToRow, tlToCol],
vExcel.Cells[drToRow, drToCol]].Select;
vExcel.ActiveSheet.Paste;
end;
procedure ExcelBorders(const vExcel: Variant;
const BorderType: Integer;
const LineStyle: Integer);
begin
vExcel.Selection.Borders[BorderType].LineStyle := LineStyle;
end;
procedure ExcelRangeCellsBorders(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const BorderType: Integer;
const LineStyle: Integer);
begin
vExcel.Range[vExcel.Cells[tlRow, tlCol],
vExcel.Cells[drRow, drCol]].Select;
ExcelBorders(vExcel, BorderType, LineStyle);
end;
procedure ExcelRangeCellsSelect(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer);
begin
vExcel.Range[vExcel.Cells[tlRow, tlCol],
vExcel.Cells[drRow, drCol]].Select;
end;
procedure ExcelFont(const vExcel: Variant;
const Name: string;
const Bold: Boolean;
const Italic: Boolean;
const Size: Integer;
const Strikethrough: Boolean;
const Superscript: Boolean;
const Subscript: Boolean;
const OutlineFont: Boolean;
const Shadow: Boolean;
const Underline: Integer;
const ColorIndex: Integer);
begin
ExcelFontName(vExcel, Name);
ExcelFontSize(vExcel, Size);
ExcelFontBold(vExcel, Bold);
ExcelFontItalic(vExcel, Italic);
vExcel.Selection.Font.Strikethrough := Strikethrough;
vExcel.Selection.Font.Superscript := Superscript;
vExcel.Selection.Font.Subscript := Subscript;
vExcel.Selection.Font.OutlineFont := OutlineFont;
vExcel.Selection.Font.Shadow := Shadow;
vExcel.Selection.Font.Underline := Underline;
vExcel.Selection.Font.ColorIndex := ColorIndex;
end;
procedure ExcelRangeCellsFont(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Name: string;
const Bold: Boolean;
const Italic: Boolean;
const Size: Integer;
const Strikethrough: Boolean;
const Superscript: Boolean;
const Subscript: Boolean;
const OutlineFont: Boolean;
const Shadow: Boolean;
const Underline: Integer;
const ColorIndex: Integer);
begin
ExcelRangeCellsSelect(vExcel, tlRow, tlCol,
drRow, drCol);
ExcelFont(vExcel, Name, Bold, Italic, Size,
Strikethrough, Superscript, Subscript,
OutlineFont, Shadow, Underline, ColorIndex);
end;
procedure ExcelFontName(const vExcel: Variant;
const Name: string);
begin
vExcel.Selection.Font.Name := Name;
end;
procedure ExcelRangeCellsFontName(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Name: string);
begin
ExcelRangeCellsSelect(vExcel, tlRow, tlCol,
drRow, drCol);
ExcelFontName(vExcel, Name);
end;
procedure ExcelFontSize(const vExcel: Variant;
const Size: Integer);
begin
vExcel.Selection.Font.Size := Size;
end;
procedure ExcelRangeCellsFontSize(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Size: Integer);
begin
ExcelRangeCellsSelect(vExcel, tlRow, tlCol,
drRow, drCol);
ExcelFontSize(vExcel, Size);
end;
procedure ExcelFontBold(const vExcel: Variant;
const Bold: Boolean);
begin
vExcel.Selection.Font.Bold := Bold;
end;
procedure ExcelRangeCellsFontBold(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Bold: Boolean);
begin
ExcelRangeCellsSelect(vExcel, tlRow, tlCol,
drRow, drCol);
ExcelFontBold(vExcel, Bold);
end;
procedure ExcelFontItalic(const vExcel: Variant;
const Italic: Boolean);
begin
vExcel.Selection.Font.Italic := Italic;
end;
procedure ExcelRangeCellsFontItalic(const vExcel: Variant;
const tlRow, tlCol,
drRow, drCol: Integer;
const Italic: Boolean);
begin
ExcelRangeCellsSelect(vExcel, tlRow, tlCol,
drRow, drCol);
ExcelFontItalic(vExcel, Italic);
end;
end.
// Пример использования:
uses
ComObj;
....
procedure Example;
var
W: variant;
begin
W := CreateOleObject('Word.Application');
W.Visible := false // не будет показывать Word
WordTableAddFromGrid(w, DBGrid1, true);
// последний параметр определяет будет ли ширина столбцов такая же как у Грида или нет
end

Далее: Обмен данными с Excel »»