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

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

{ **** UBPFD *********** by kladovka.net.ru ****
>>
Некоторые процедуры для работы с с MSWord и MSExcel, которыми активно пользуюсь сам и предлагаю остальным. Есть как простые функции такие как открытие документа, получение текста документа, управление окнами и т.п. так и более продвинутые: добавление таблицы в MSWord или MSExcel из DBGrid, ListView и т.п. Описывать все не буду, постарался чтобы из названия функций было понятно.
Зависимости: Windows, Messages, SysUtils, Classes, Comctrls,Grids, DBGrids, WordConst, ExcelConst
Автор: FalicSoft, <a href="mailto:falicsoft@narod.ru">falicsoft@narod.ru</a>, Москва
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;
xlVAlign=-4160;
{Borders}
xlInsideHorizontal=12;
xlInsideVertical=11;
xlDiagonalDown=5;
xlDiagonalUp=6;
xlEdgeBottom=9;
xlEdgeLeft=7;
xlEdgeRight=10;
xlEdge=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 WordWindowActivate(const vWord: Variant);
procedure WordWindowActivate(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 WordTablesCellValue(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
  WordTablesCellValue(vWord,
  ListView.Column[j].Caption);
 end;
 For i:=0 To ListView.Items.Count-1 Do begin
  WordTablesCellValue(vWord,
  ListView.Items.Item[i].Caption);
  For j:=0 To ListView.Columns.Count-2 Do
  If ListView.Items.Item[i].SubItems.Count>j Then
  WordTablesCellValue(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
  WordTablesCellValue(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
  WordTablesCellValue(vWord,
  DBGrid.Columns.Items[j].Field.AsString);
  DBGrid.DataSource.DataSet.;
  end;
  DBGrid.DataSource.DataSet.First;
end;
procedure WordTablesCellValue(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 WordWindowActivate(const vWord: Variant);
begin
 vWord.ActiveWindow..Activate;
end;
procedure WordWindowActivate(const vWord: Variant);
begin
 vWord.ActiveWindow..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.;
  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

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...