Консультации Портала - Консультация #180440

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 180440

25.10.2010, 11:29

47.08 руб.

0 46 1

Компьютеры Программирование

Здравствуйте. Помогите исправить ошибку EOleSysError with message неверный тип переменной
и сделать программу работоспособной.
Пишу программу на delphi cjdegear 2009
Ошибка возникает при нажатии на кнопки

Код:

procedure TForm1.Button3Click(Sender: TObject);//пишем текст в textbox
begin
BoxName_:=SetNewNameShape(BoxName_,'Новое имя');
TextToTextBox(BoxName_,'Доб');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
DeleteShape(LineName_);//удаляем textbox
DeleteShape(BoxName_);//удаляем line
end;

вот исходник кликните сюда (сдесь файл проекта)

Приложение:
//файл unit1.pas
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,MyWord, StdCtrls, OleServer;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
BoxName_,LineName_:string;
W:variant;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateWord();
VisibleWord(true);
AddDoc;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CreateTextBox(1,1,100,50,BoxName_);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
BoxName_:=SetNewNameShape(BoxName_,'Новое имя');
TextToTextBox(BoxName_,'Доб');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
CreateLine(1,1,100,50,LineName_);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
DeleteShape(LineName_);
DeleteShape(BoxName_);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
SaveDocAs('F:\doc.doc');
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
CloseDoc;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
CloseWord;
end;

procedure TForm1.Button9Click(Sender: TObject);

var BoxName_,LineName_:string;
begin
CreateTextBox(1,1,100,50,BoxName_);
messagebox(0,pchar(GetNameIndexShape(1)),'Считали имя формы',0);
BoxName_:=SetNewNameShape(BoxName_,'Новое имя');
messagebox(0,pchar(GetNameIndexShape(1)),'Изменили имя формы и считываем его снова',0);
TextToTextBox(BoxName_,'Добавляем текст в TextBox');

messagebox(0,'Рисуем линию','',0);
CreateLine(1,15,300,200,LineName_);
messagebox(0,'Удаляем линию','',0);
DeleteShape(LineName_);
messagebox(0,'Удаляем надпись','',0);
DeleteShape(BoxName_);
end;
end.

//файл myword.pas
unit MyWord;

interface

const
wdBorderTop=-1;
wdBorderLeft=-2;
wdBorderBottom=-3;
wdBorderRight=-4;

wdLineStyleNone=0;
wdLineStyleSingle=1;
wdLineStyleDot=2;
wdLineStyleDashSmallGap=3;
wdLineStyleDashLargeGap=4;
wdLineStyleDashDot=5;
wdLineStyleDashDotDot=6;
wdLineStyleDouble=7;
wdLineStyleTriple=8;
wdLineStyleThinThickSmallGap=9;
wdLineStyleThickThinSmallGap=10;
wdLineStyleThinThickThinSmallGap=11;
wdLineStyleThinThickMedGap=12;
wdLineStyleThickThinMedGap=13;
wdLineStyleThinThickThinMedGap=14;
wdLineStyleThinThickLargeGap=15;
wdLineStyleThickThinLargeGap=16;
wdLineStyleThinThickThinLargeGap=17;
wdLineStyleSingleWavy=18;
wdLineStyleDoubleWavy=19;
wdLineStyleDashDotStroked=20;
wdLineStyleEmboss3D=21;
wdLineStyleEngrave3D=22;

Function CreateWord:boolean;
Function VisibleWord(visible:boolean):boolean;
Function AddDoc:boolean;
Function SetTextToDoc(text_:string ;InsertAfter_:boolean):boolean;
Function SaveDocAs(file_:string):boolean;
Function SaveDocAsUnicod(file_:string):boolean;
Function SaveDocAsText(file_:string):boolean;
Function SaveDocAsDosText(file_:string):boolean;
Function CloseDoc:boolean;
Function CloseWord:boolean;
Function OpenDoc(file_:string):boolean;
Function StartOfDoc:boolean;
Function FindTextDoc(text_:string):boolean;
Function PasteTextDoc(text_:string):boolean;
Function TypeTextDoc(text_:string):boolean;
Function FindAndPasteTextDoc(findtext_,pastetext_:string):boolean;
Function PrintDialogWord:boolean;
Function CreateTable(NumRows, NumColumns:integer;var index:integer):boolean;
Function SetSizeTable(Table:integer;RowsHeight, ColumnsWidth:real):boolean;
Function GetSizeTable(Table:integer;var RowsHeight,ColumnsWidth:real):boolean;
Function SetHeightRowTable(Table,Row:integer;RowHeight:real):boolean;
Function SetWidthColumnTable(Table,Column:integer;ColumnWidth:real):boolean;
Function SetTextToTable(Table:integer;Row,Column:integer;text:string):boolean;
Function SetLineStyleBorderTable(Table:integer;Row,Column,wdBorderType,wdBorderStyle:integer):boolean;
Function SetMergeCellsTable(Table:integer;Row1,Column1,Row2,Column2:integer):boolean;

Function GetSelectionTable:boolean;
Function GoToNextTable (table_:integer):boolean;
Function GoToPreviousTable (table_:integer):boolean;
Function GetColumnsRowsTable(table_:integer; var Columns,Rows:integer):boolean;
Function GetColumnRowTable(table_:integer; var Column,Row:integer):boolean;
Function AddRowTableDoc (table_:integer):boolean;
Function InsertRowsTableDoc(table_,position_,count_:integer):boolean;
Function InsertRowTableDoc(table_,position_:integer):boolean;

//------------------------------- TextBox ---------------------------------
Function CreateTextBox(Left,Top,Width,Height:real;var name:string):boolean;
Function TextToTextBox(TextBox:variant;text:string):boolean;

//------------------------------- Линии -----------------------------------
Function CreateLine(BeginX,BeginY,EndX,EndY:real;var name:string):boolean;

//------------------------------- Внешний рисунок -------------------------
Function CreatePicture(FileName:string;Left,Top:real;var name:string):boolean;

//------------------------------- Общие для формы функции -----------------
Function DeleteShape (NameShape:variant): variant;
Function SetNewNameShape(NameShape:variant;NewNameShape:string):string;
Function GetNameIndexShape(NameIndex:variant):string;

implementation

uses ComObj;
var W:variant;

Function CreateWord:boolean;
begin
CreateWord:=true;
try
W:=CreateOleObject('Word.Application');
except
CreateWord:=false;
end;
End;

Function VisibleWord(visible:boolean):boolean;
begin
VisibleWord:=true;
try
W.visible:= visible;
except
VisibleWord:=false;
end;
End;

Function AddDoc:boolean;
Var Doc_:variant;
begin
AddDoc:=true;
try
Doc_:=W.Documents;
Doc_.Add;
except
AddDoc:=false;
end;
End;

Function SetTextToDoc(text_:string ;InsertAfter_:boolean):boolean;
var Rng_:variant;
begin
SetTextToDoc:=true;
try
Rng_:=W.ActiveDocument.Range;
if InsertAfter_ then Rng_.InsertAfter(text_) else Rng_.InsertBefore(text_);
except
SetTextToDoc:=false;
end;
End;

Function SaveDocAs(file_:string):boolean;
begin
SaveDocAs:=true;
try
W.ActiveDocument.SaveAs(file_);
except
SaveDocAs:=false;
end;
End;

Function SaveDocAsUnicod(file_:string):boolean;
const wdFormatUnicodeText=7;
begin
SaveDocAsUnicod:=true;
try
W.ActiveDocument.SaveAs(file_,FileFormat:=wdFormatUnicodeText);
except
SaveDocAsUnicod:=false;
end;
End;

Function SaveDocAsText(file_:string):boolean;
const wdFormatText=2;
begin
SaveDocAsText:=true;
try
W.ActiveDocument.SaveAs(file_,FileFormat:= wdFormatText);
except
SaveDocAsText:=false;
end;
End;

Function SaveDocAsDosText(file_:string):boolean;
const wdFormatDOSText=4;
begin
SaveDocAsDosText:=true;
try
W.ActiveDocument.SaveAs(file_,FileFormat:= wdFormatDOSText);
except
SaveDocAsDosText:=false;
end;
End;

Function CloseDoc:boolean;
begin
CloseDoc:=true;
try
W.ActiveDocument.Close;
except
CloseDoc:=false;
end;
End;

Function CloseWord:boolean;
begin
CloseWord:=true;
try
W.Quit;
except
CloseWord:=false;
end;
End;

Function OpenDoc(file_:string):boolean;
Var Doc_:variant;
begin
OpenDoc:=true;
try
Doc_:=W.Documents;
Doc_.Open(file_);
except
OpenDoc:=false;
end;
End;

Function StartOfDoc:boolean;
begin
StartOfDoc:=true;
try
W.Selection.End:=0;
W.Selection.Start:=0;
except
StartOfDoc:=false;
end;
End;

Function FindTextDoc(text_:string):boolean;
begin
FindTextDoc:=true;
Try
W.Selection.Find.Forward:=true;
W.Selection.Find.Text:=text_;
FindTextDoc := W.Selection.Find.Execute;
except
FindTextDoc:=false;
end;
End;

Function PasteTextDoc(text_:string):boolean;
begin
PasteTextDoc:=true;
Try
W.Selection.Delete;
W.Selection.InsertAfter (text_);
except
PasteTextDoc:=false;
end;
End;

Function TypeTextDoc(text_:string):boolean;
begin
TypeTextDoc:=true;
Try
W.Selection.Delete;
W.Selection.TypeText(text_);
except
TypeTextDoc:=false;
end;
End;

Function FindAndPasteTextDoc(findtext_,pastetext_:string):boolean;
begin
FindAndPasteTextDoc:=true;
try
W.Selection.Find.Forward:=true;
W.Selection.Find.Text:= findtext_;
if W.Selection.Find.Execute then begin
W.Selection.Delete;
W.Selection.InsertAfter (pastetext_);
end else FindAndPasteTextDoc:=false;
except
FindAndPasteTextDoc:=false;
end;
End;

Function PrintDialogWord:boolean;
Const wdDialogFilePrint=88;
begin
PrintDialogWord:=true;
try
W.Dialogs.Item(wdDialogFilePrint).Show;
except
PrintDialogWord:=false;
end;
End;

//----------- Таблицы --------------------------------------------------
Function CreateTable(NumRows, NumColumns:integer;var index:integer):boolean;
var sel_:variant;
begin
CreateTable:=true;
try
sel_:=W.selection;
W.ActiveDocument.Tables.Add(Range:=sel_.Range, NumRows:=NumRows, NumColumns:=NumColumns);
index:=W.ActiveDocument.Tables.Count;
except
CreateTable:=false;
end;
End;

Function SetSizeTable(Table:integer;RowsHeight, ColumnsWidth:real):boolean;
begin
SetSizeTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Width:=ColumnsWidth;
W.ActiveDocument.Tables.Item(Table).Rows.Height:=RowsHeight;
except
SetSizeTable:=false;
end;
End;

Function GetSizeTable(Table:integer;var RowsHeight,ColumnsWidth:real):boolean;
begin
GetSizeTable:=true;
try
ColumnsWidth:=W.ActiveDocument.Tables.Item(Table).Columns.Width;
RowsHeight:=W.ActiveDocument.Tables.Item(Table).Rows.Height;
except
GetSizeTable:=false;
end;
End;

Function SetHeightRowTable(Table,Row:integer;RowHeight:real):boolean;
begin
SetHeightRowTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Rows.item(Row).Height:=RowHeight;
except
SetHeightRowTable:=false;
end;
End;

Function SetWidthColumnTable(Table,Column:integer;ColumnWidth:real):boolean;
begin
SetWidthColumnTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Item(Column).Width:=ColumnWidth;
except
SetWidthColumnTable:=false;
end;
End;

Function SetTextToTable(Table:integer;Row,Column:integer;text:string):boolean;
begin
SetTextToTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Item(Column).Cells.Item(Row).Range.Text:=text;
except
SetTextToTable:=false;
end;
End;

Function SetLineStyleBorderTable(Table:integer;Row,Column,wdBorderType,wdBorderStyle:integer):boolean;
begin
SetLineStyleBorderTable:=true;
try
W.ActiveDocument.Tables.Item(Table).Columns.Item(Column).Cells.Item(Row).Borders.Item(wdBorderType).LineStyle:=wdBorderStyle;
except
SetLineStyleBorderTable:=false;
end;
End;

Function SetMergeCellsTable(Table:integer;Row1,Column1,Row2,Column2:integer):boolean;
var cel_:variant;
begin
SetMergeCellsTable:=true;
try
cel_:=W.ActiveDocument.Tables.Item(Table).Cell(Row2,Column2);
W.ActiveDocument.Tables.Item(Table).Cell(Row1,Column1).Merge(cel_);
except
SetMergeCellsTable:=false;
end;
End;

Function GetSelectionTable:boolean;
const wdWithInTable=12;
begin
try
GetSelectionTable :=W.Selection.Information[wdWithInTable];
except
GetSelectionTable :=false;
end;
End;

Function GoToNextTable (table_:integer):boolean;
const wdGoToTable=2;
begin
GoToNextTable:=true;
try
W.Selection.GoToNext (wdGoToTable);
except
GoToNextTable:=false;
end;
End;

Function GoToPreviousTable (table_:integer):boolean;
const wdGoToTable=2;
begin
GoToPreviousTable:=true;
try
W.Selection.GoToPrevious(wdGoToTable);
except
GoToPreviousTable:=false;
end;
End;

Function GetColumnsRowsTable(table_:integer; var Columns,Rows:integer):boolean;
const
wdMaximumNumberOfColumns=18;
wdMaximumNumberOfRows=15;
begin
GetColumnsRowsTable:=true;
try
Columns:=W.Selection.Information[wdMaximumNumberOfColumns];
Rows:=W.Selection.Information[wdMaximumNumberOfRows];
except
GetColumnsRowsTable:=false;
end;
End;

Function GetColumnRowTable(table_:integer; var Column,Row:integer):boolean;
const
wdStartOfRangeColumnNumber=16;
wdStartOfRangeRowNumber=13;
begin
GetColumnRowTable:=true;
try
Column:=W.Selection.Information[wdStartOfRangeColumnNumber];
Row:=W.Selection.Information[wdStartOfRangeRowNumber];
except
GetColumnRowTable:=false;
end;
End;

Function AddRowTableDoc (table_:integer):boolean;
begin
AddRowTableDoc:=true;
try
W.ActiveDocument.Tables.Item(table_).Rows.Add;
except
AddRowTableDoc:=false;
end;
End;

Function InsertRowsTableDoc(table_,position_,count_:integer):boolean;
begin
InsertRowsTableDoc:=true;
try
W.ActiveDocument.Tables.Item(table_).Rows.Item(position_).Select;
W.Selection.InsertRows (count_);
except
InsertRowsTableDoc:=false;
end;
End;

Function InsertRowTableDoc(table_,position_:integer):boolean;
var row_:variant;
begin
InsertRowTableDoc:=true;
try
row_:=W.ActiveDocument.Tables.Item(table_).Rows.Item(position_);
W.ActiveDocument.Tables.Item(table_).Rows.Add(row_);
except
InsertRowTableDoc:=false;
end;
End;

//------------------------------ TextBox ----------------------------------
Function CreateTextBox(Left,Top,Width,Height:real;var name:string):boolean;
const msoTextOrientationHorizontal=1;
begin
CreateTextBox:=true;
try
name:=W.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,Left,Top,Width,Height).Name;
except
CreateTextBox:=false;
end;
End;

Function TextToTextBox(TextBox:variant;text:string):boolean;
const msoTextBox=17;
begin
TextToTextBox:=true;
try
if w.ActiveDocument.Shapes.Item(TextBox).Type = msoTextBox then
W.ActiveDocument.Shapes.Item(TextBox).TextFrame.TextRange.Text:=Text
else TextToTextBox:=false;
except
TextToTextBox:=false;
end;
End;

Function CreateLine(BeginX,BeginY,EndX,EndY:real;var name:string):boolean;
begin
CreateLine:=true;
try
name:=W.ActiveDocument.Shapes.AddLine(BeginX,BeginY,EndX,EndY).Name;
except
CreateLine:=false;
end;
End;

Function CreatePicture(FileName:string;Left,Top:real;var name:string):boolean;
begin
CreatePicture:=true;
try
name:=W.ActiveDocument.Shapes.AddPicture(FileName).Name;
W.ActiveDocument.Shapes.Item(name).Left:=Left;
W.ActiveDocument.Shapes.Item(name).Top:=Top;
except
CreatePicture:=false;
end;
End;

Function GetNameIndexShape(NameIndex:variant):string;
begin
try
GetNameIndexShape:=W.ActiveDocument.Shapes.Item(NameIndex).Name;
except
GetNameIndexShape:='';
end;
End;

Function SetNewNameShape(NameShape:variant;NewNameShape:string):string;
begin
try
W.ActiveDocument.Shapes.Item(NameShape).Name:=NewNameShape;
SetNewNameShape:=NewNameShape;
except
SetNewNameShape:='';
end;
End;

Function DeleteShape (NameShape:variant): variant;
Begin
DeleteShape:=true;
try
W.ActiveDocument.Shapes.Item(NameShape).Delete;
except
DeleteShape:=false;
end;
End;
end.

Обсуждение

Неизвестный

25.10.2010, 16:24

общий

А выше? Строка 74:

Код:


//------------------------------- TextBox ---------------------------------
Function CreateTextBox(Left,Top,Width,Height:real;var name:string):boolean;
Function TextToTextBox(TextBox:variant;text:string):boolean;

И ещё чуть ниже (для функции DeleteShape):

Код:


//------------------------------- Общие для формы функции -----------------
Function DeleteShape (NameShape:variant): variant;

Неизвестный

25.10.2010, 16:28

общий

спасибо, все заработало.

Неизвестный

25.10.2010, 16:30

общий

ok!

давно

Вадим Исаев ака sir Henry

Мастер-Эксперт
425
4118

25.10.2010, 16:43

общий

tatyana:
Оформите как ответ - получите денюжку.

Только по-умному, чтобы у человека сразу заработало.

Об авторе:
Я только в одном глубоко убеждён - не надо иметь убеждений! :)

Неизвестный

25.10.2010, 17:02

общий

это ответ

Здравствуйте, novij2011!

Вам нужно немного доработать свой код в файле MyWord.pas.

1. Прежде всего, измените объявление переменной W на OleVariant.
У Вас сейчас:
var W:variant;

Должно быть:
var W: OleVariant;

2. Выполните аналогичную замену в объявлении и реализации функции TextToTextBox.
Строки 74 и 535 должны выглядеть так:
Function TextToTextBox(TextBox: OleVariant;text:string):boolean;

3. То же самое нужно сделать с функцией DeleteShape
Внесите аналогичные замены типа в строки 83 и 598. Должно быть так:
Function DeleteShape (NameShape: OleVariant): OleVariant;

Перекомпилируйте проект.

спасибо

Неизвестный

25.10.2010, 17:31

общий

tatjana:
a можешь еще пояснить в чем ощибка в этой функции

Код:


Function FontLegendEntries(Name,LegendEntries:OLEvariant;Font:TFont):boolean;
begin
 FontLegendEntries:=true;
try
FontLegendEntries:=FontToEFont(Font,E.Charts.Item[name].Legend.LegendEntries.Item[LegendEntries].Font);
except
FontLegendEntries:=false;
 end;
End;

в строке

Код:

FontLegendEntries:=FontToEFont(Font,E.Charts.Item[name].Legend.LegendEntries.Item[LegendEntries].Font);

выдал
Exception class EOleSysError with message 'Член группы не найден'.

Неизвестный

25.10.2010, 17:44

общий

Что такое E? Excel.Application? Возможно, проблема в версиях, а можно еще попробовать заменить TFont на OLE_Font

давно

Орловский Дмитрий

Мастер-Эксперт
319965
1463

25.10.2010, 17:51

общий

novij2011:
Вы писали:

в интернете читал, что нужно тип на ansistring менять, но незнаю как и где.
может это поможет.

Поможет. Это нужно сделать везде, т.е. всюду заменяете слово string на слово ansistring и назвается это портированием кода в новую версию. А проблема портирования заключается в том, что тип String теперь обозначает другой тип, чем тот, который был в прежних версиях Delphi. А старый тип теперь в новом Delphi называется AnsiString.

Неизвестный

25.10.2010, 17:53

общий

В Ole-приложениях лучше все-таки использовать WideString

Неизвестный

25.10.2010, 18:00

общий

Цитата: 340485

Что такое E? Excel.Application? Возможно, проблема в версиях, а можно еще попробовать заменить TFont на OLE_Font

OLE_Font пишет что это незвестный идентификатор.

а E - это переменная, типа OLEvariant для Excel
E:=CreateOleObject('Excel.Application');

Неизвестный

25.10.2010, 18:14

общий

Мне, к сожалению, сейчас бежать нужно. Буду в онлайне поздно вечером.
Ищи объявление функции FontToEFont и проверяй соответствие типов.
Если не поможет, ищи здесь E.Charts.Item[name].Legend.LegendEntries.Item[LegendEntries].Font
Как искать? Вводи переменные внутри функции, соответствующие свойствам до точки, например:
var ch: OleVariant;
...
ch := E.Charts;

...
... ch.Item[name]....
Понятно? и тогда получишь точно, какой именно член и какой группы не найден...

Неизвестный

25.10.2010, 18:16

общий

пасиба

Неизвестный

25.10.2010, 19:52

общий

при присвоении ch:=E.Charts.Item[name].Legend.legendEntries.Item[LegendEntries];
cтало выдавать эту ошибку
Exception class EOleSysError with message 'Член группы не найден'.

Неизвестный

25.10.2010, 21:17

общий

Возможно вместо

Код:


E.Charts.Item[name].Legend.LegendEntries.Item[LegendEntries].Font

нужно писать

Код:


E.Charts.Item[name].Legend.Item[LegendEntries].Font

По всей видимости здесь LegendEntries - это индекс элемента легенды и тогда такая запись

Код:

Legend.LegendEntries.Item[LegendEntries]

просто не логична

Неизвестный

25.10.2010, 21:35

общий

Прошу прощения. Немного не так.
В записи

Код:

E.Charts.Item[name].Legend.LegendEntries.Item[[i]LegendEntries[/i]].Font

нужно уточнить переменную для индекса члена легенды.
Возможно, должно быть так:

Код:

E.Charts.Item[name].Legend.LegendEntries.Item[[b]name[/b]].Font

Но совсем не обязательно, так как число элементов легенды может отличаться от числа элементов диаграммы.

Заморочка вот в этом LegendEntries. С одной стороны Этот идентификатор используется как коллекция (что правильно),
а с другой стороны - как индекс элемента той же самой коллекции (что неправильно).
Ваша задача выяснить, что должно быть на месте этого индекса.

Легенда включает в себя дополнительные объекты, объединенные в коллекцию LegendEntries.
Это элементы легенды, их количество совпадает с количеством рядов диаграммы.
Доступ к элементам легенды осуществляется посредством коллекции LegendEntries с помощью индекса элемента
(целого числа из диапазона от 1 до LegendEntries.Count, где Count — количество элементов легенды).

Неизвестный

26.10.2010, 14:38

общий

мне получается в код

Код:

E.Charts.Item[name].Legend.LegendEntries.Item[name].Font

вставлять на место

Код:

LegendEntries.Item[1].

Код:

LegendEntries.Item[2].

или я что то не понял?

Неизвестный

26.10.2010, 14:50

общий

Ну попробуй написать так:

Код:

E.Charts.Item[name].Legend.LegendEntries.Item[1].Font

хотя бы для того, чтобы убедиться, что ошибка именно в этом

Неизвестный

26.10.2010, 15:35

общий

выдало ошибку член группы не найден

Неизвестный

26.10.2010, 16:18

общий

Сам Excel поднимается?
Проверяйте значение name. Возможно, здесь имеет место элементарный выход за границы и не работает эта часть:

Код:

E.Charts.Item[name]

И еще. Это строка тоже из методички? Если с name все в порядке, то попробуй такой код:

Код:

E.Charts.Chart[name].Legend.LegendEntries.Item[1].Font

Неизвестный

26.10.2010, 16:49

общий

при вводе строки

Код:

E.Charts.Chart[name].Legend.LegendEntries.Item[1].Font

выдал
Exception class EOleError with message 'Method 'Chart' not supported by automation object'

эта строка тоже из методички

Неизвестный

26.10.2010, 17:24

общий

Ну тогда остается одно.
Сh, l, le, leI: OleVariant;

Ch := E.Charts.Item[name] ;
l := E.Charts.Item[name].Legend;
le := E.Charts.Item[name].Legend.LegendEntries;
leI := E.Charts.Item[name].Legend.LegendEntries.Item[1];

Пожалуй, больше ничего полезного без кода я не смогу присоветовать. Если в вашем Excel'e установлена справка по VBA, найдите раздел (в справке)
Microsoft Excel Objects Model и дальше Collections и Objects.

Неизвестный

26.10.2010, 17:56

общий

ошибку выдал на пследнем этапе
leI := E.Charts.Item[name].Legend.LegendEntries.Item[1];

Неизвестный

26.10.2010, 17:58

общий

вот код

Код:


procedure TForm1.Button12Click(Sender: TObject);
begin
if not FontDialog1.Execute then exit;
FontLegendEntries(ChartName,1,FontDialog1.Font);
end;

Код:


unit MyExcel;

interface
uses Classes,Graphics,ComCtrls, ComObj, variants, SysUtils, Controls, Forms, Dialogs, StdCtrls, Windows;
var E:OLEvariant;
     ChartName:OLEvariant;
Function FontToEFont (font:Tfont;EFont:OLEvariant):boolean;
Begin
 FontToEFont:=true;
 try
  EFont.Name:=font.Name;
  if fsBold in font.Style
   then EFont.Bold:=True // Жирный
   else EFont.Bold:=False; // Тонкий
  if fsItalic in font.Style
   then EFont.Italic:=True // Наклонный
   else EFont.Italic:=False; // Наклонный
  EFont.Size:=font.Size; // Размер
  if fsStrikeOut in font.Style
   then EFont.Strikethrough:=True // Перечеркнутый
   else EFont.Strikethrough:=False; // Перечеркнутый
  if fsUnderline in font.Style
   then EFont.Underline:=xlUnderlineStyleSingle // Подчеркивание
   else EFont.Underline:=xlUnderlineStyleNone; // Подчеркивание
  EFont.Color:=font.Color; // Цвет
 except
  FontToEFont:=false;
 end;
End;

Function FontLegendEntries(Name,LegendEntries:OLEvariant;
  Font:TFont):boolean;
  var
   l, le, leI: OleVariant;
   ch:OleVariant;



begin
 FontLegendEntries:=true;
 try
  ch := E.Charts.Item[name] ;
l := E.Charts.Item[name].Legend;
le := E.Charts.Item[name].Legend.LegendEntries;
leI := E.Charts.Item[name].Legend.LegendEntries.Item[1];




//FontLegendEntries:=FontToEFont(Font, E.Charts.Item[name].Legend.LegendEntries.Item[name].Font);


//FontLegendEntries:=FontToEFont(Font,E.Charts.Item[name].Legend.LegendEntries.Item[LegendEntries].Font);
 except
  FontLegendEntries:=false;
 end;
End;

Неизвестный

26.10.2010, 22:25

общий

Код:

unit MyExcel;

interface
uses Classes,Graphics,ComCtrls, ComObj, variants, SysUtils, Controls, Forms, Dialogs, StdCtrls, Windows;
var E:OLEvariant;
     ChartName:OLEvariant;
.........................................

Function FontLegendEntries(Name, Le:variant;  Font:TFont):boolean;
begin
 FontLegendEntries:=true;
 try
   FontLegendEntries:=FontToEFont(Font,E.Charts.Item[name].Legend.LegendEntries.Item[le].Font);
 except
  FontLegendEntries:=false;
 end;
End;

Надеюсь, это не весь код?
Обратите внимание: я заменила наименование параметра в объявлении функции. Ну и возвращаемся к началу разговора...
Пробуйте...

Неизвестный

27.10.2010, 11:48

общий

опять выдал ошибку член группы не найден

в строке
FontLegendEntries:=FontToEFont(Font,E.Charts.Item[name].Legend.LegendEntries.Item[le].Font);

Неизвестный

27.10.2010, 12:30

общий

В приведенном Вами куске кода не видна предыдущая последовательность действий.
А она должна быть следующая:
1. Открываем Excel (CreateOleObject)
2. Делаем его видимым
3. Создаем WorkSheet (E.Workbooks.Add;)
4. Выбираем этот лист для работы (E.ActiveWorkbook.Sheets.Item[sheet].Select)
5. Создаем диаграмму (заодно выполняется инициализация переменной name)

Код:

try
name:=E.Charts.Add.Name;
E.Charts.Item[name].ChartType:=ChartType;
except
AddChart:=false;
end;

6. Заполняем созданную диаграмму какими-нибудь данными и строим столбики

Код:

E.ActiveWorkbook.Charts.Item[name].SetSourceData(Source:=E.ActiveWorkbook.Sheets.Item[Sheet].Range[Range],PlotBy:=XlRowCol);

7. И только теперь (!) мы можем менять фонт

Код:

if not FontDialog1.Execute then exit;
FontLegendEntries(ChartName,1,FontDialog1.Font);

В такой последовательности ошибок нет. Если у вас все именно так, то:
- Ваша версия MS Office?
У меня = MS Office 2003

Неизвестный

27.10.2010, 17:19

общий

у меня офис 2007.
всю последовательность выполняю правильно.
еще покажу код заполнения данными, может должно быть там подругому

Код:


rocedure TForm1.Button25Click(Sender: TObject);
 var a_:integer;
   rng_:string;
begin
randomize;
SetRange(2,'A1','AAAA');
SetRange(2,'B1','BBBB');
SetRange(2,'C1','CCCC');
SetRange(2,'D1','AAAA');
SetRange(2,'E1','BBBB');
SetRange(2,'F1','CCCC');
for a_:=2 to 5 do begin
    SetRange(2,'A'+inttostr(a_),a_-1);
    SetRange(2,'B'+inttostr(a_),random(1000));
    SetRange(2,'C'+inttostr(a_),random(1000));
    SetRange(2,'D'+inttostr(a_),random(1000));
    SetRange(2,'E'+inttostr(a_),random(1000));
    SetRange(2,'F'+inttostr(a_),random(1000));
    end;
end;

Код:


Function SetSourceData(Name,Sheet:OLEvariant;Range:string;XlRowCol:integer):boolean;
begin
 SetSourceData:=true;
 try
  E.ActiveWorkbook.Charts.Item[name].SetSourceData(Source:=E.ActiveWorkbook.Sheets.Item [Sheet].Range[Range],PlotBy:=XlRowCol);
 except
  SetSourceData:=false;
 end;
End;

Неизвестный

27.10.2010, 17:29

общий

Ладно, видимо, все дело в версии офиса. Я попробую поискать информацию о различиях программирования в офисе 2007
Может, вы сможете запустить свою программу где-то, где есть офис 2003?

Неизвестный

27.10.2010, 18:00

общий

у нас везде уже 2007 стоит. Если запускается на 2003 тогда я тоже псмотрю как запустить на 2007 версии.
спасибо вам за помощь.

давно

Вадим Исаев ака sir Henry

Мастер-Эксперт
425
4118

28.10.2010, 03:21

общий

novij2011:
Первым делом нужно заглядывать в справку по VBA, которая идёт в комплекте с конкретной версией Офиса. К сожалению у Микрософт изменяются передаваемые параметры в одних и тех же функцуиях разных версий Офиса. Поэтому нужно обязательно заглядывать в справку по VBA.

Об авторе:
Я только в одном глубоко убеждён - не надо иметь убеждений! :)

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.