VPF::Глюк при передаче чисел в Excel из Delphi

demoniqus

Дата 12.7.2011, 09:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 29
Регистрация: 15.11.2006

Репутация: нет
Всего: 1

Есть код программы в Дельфи

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleServer, ExcelXP, Excel97, Excel2000, StdCtrls, ComCtrls, ComObj,
  Registry,   CheckLst, ExtCtrls, Mask, Buttons, Grids, Calendar, Menus,
  WordXP, Printers, WinSpool, ActiveX, ShlObj;

type
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Path: string;
  HomePath, HomeDrive: string;
implementation
  uses VBIDE97, Math, DateUtils, StrUtils, Types;

var
  XL1: variant;
  SR: TSearchRec;
  FileName, FileName1: string;
  Sheet, Sheet2, Workbook, Workbook2: variant;
  Ole: olevariant;
  i: integer;

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
Form1.Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
x, y: integer;
Cell, Value, tmp: string;
Stroke, s1, s2, s3: string;
fname: string;
Reg: TRegistry;
F: TextFile;
begin
Reg:= TRegistry.Create;
Reg.RootKey:= HKEY_CURRENT_USER;
Reg.OpenKeyReadOnly('Volatile Environment');
HomeDrive:= reg.ReadString('HOMEDRIVE');
HomePath:= reg.ReadString('HOMEPATH');
Reg.CloseKey;
Path:= HomeDrive + HomePath + '\Ìîè äîêóìåíòû\';
if (not DirectoryExists(Path)) then
begin
  Path:= HomeDrive + HomePath + '\My Documents\';
  if (Not DirectoryExists(Path)) then
    Path:= HomeDrive + HomePath;
end;
i:= 1;
XL1:= CreateOleObject('Excel.Application');
XL1.Visible:= false;

XL1.DisplayAlerts:= false;
XL1.UseSystemSeparators:= true;
XL1.Workbooks.Open('Z:\home\sitrans.ru\www\forms\Tomilino.xls', False, False, EmptyParam, False,
                False, True, EmptyParam, False, EmptyParam, EmptyParam,
                                               EmptyParam, EmptyParam);
Sheet:= XL1.Workbooks[1].Worksheets[i];


AssignFile (F, 'Z:\home\sitrans.ru\www\forms\Tomilino.txt');
Reset(F);
Readln(F, Stroke);
fname:= 'Îò÷åò_Òîìèëèíî_' + Stroke;

while not Eof(F) do
begin
  Readln(F, Stroke);
  if (Pos('NewSheetInTomilino', Stroke) = 1) then
  begin
    i:= i + 1;
    Sheet:= XL1.Workbooks[1].Worksheets[i];
    continue;
  end;
  s1:= Copy (Stroke, 1, Pos (';', Stroke) - 1);
  s2:= Copy (Stroke, Pos (';', Stroke) + 1, Length (Stroke) -
                                          Pos (';', Stroke));
  s3:= Stroke;
  s2:= Copy (s2, 1, Pos (';', s2) - 1);
  s3:= Copy (s3, Pos (';', s3) + 1, Length (s3) - Pos (';', s3));
  s3:= Copy (s3, Pos (';', s3) + 1, Length (s3) - Pos (';', s3));
  s3:= StringReplace(s3, '#10', #10, [rfReplaceAll]);
  if s2 = 'merge' then
  begin
    Sheet.Range[s1, EmptyParam].Merge;
  end;
  if s2 = 'autofit' then
  begin
    Sheet.Range[s1, EmptyParam].EntireColumn.AutoFit;
  end;
  if s2 = 'value2' then
  begin
    Sheet.Range[s1, EmptyParam].value2:= s3;
  end;
  if s2 = 'borders' then
  begin
    Sheet.Range[s1, EmptyParam].Borders.LineStyle:= xlContinuous;
    Sheet.Range[s1, EmptyParam].Borders.Weight:= xlMedium;
  end;
  if s2 = 'value' then
  begin
    Sheet.Range[s1, EmptyParam].value:= s3;
  end;
  if s2 = 'formulaR1C1' then
  begin
    Sheet.Range[s1, EmptyParam].formulaR1C1:= s3;
  end;
  if s2 = 'formulaLocal' then
  begin
    Sheet.Range[s1, EmptyParam].formulaLocal:= s3;
  end;
  if s2 = 'numberFormat' then
  begin
    Sheet.Range[s1, EmptyParam].numberFormat:= s3;
  end;
  if s2 = 'HorizontalAlignment' then
  begin
    Sheet.Range[s1, EmptyParam].HorizontalAlignment:= xlCenter;
  end;
  if s2 = 'VerticalAlignment' then
  begin
    Sheet.Range[s1, EmptyParam].VerticalAlignment:= xlCenter;
  end;
  if s2 = 'WrapText' then
  begin
    Sheet.Range[s1, EmptyParam].WrapText:= true;
  end;
end;

if FileExists(Path + fname) then
begin
  try
    DeleteFile(Path + fname);
    XL1.Workbooks[1].Close(True, Path + fname, EmptyParam);
  except
    fname:= StringReplace(DateTimeToStr(Now), ':', '.', [rfreplaceall]) + '__' + fname;
    try
      XL1.Workbooks[1].Close(True, Path + fname, EmptyParam);
    except

    end;
  end;
end
else
  XL1.Workbooks[1].Close(True, Path + fname, EmptyParam);
XL1.quit;
end;

end.

Данная программа открывает текстовый файл Tomilino.txt и форму для заполнения Tomilino.xls
Текстовый файл является набором команд в следующем формате: [диапазон ячеек];[требуемое действие];[дополнительные параметры, типа вводимого цвета, задаваемого выравнивания и т.д.]
Проблема возникает в командах value и value2. Команда H2;value;1,065 (а также команда H2;value2;1,065) приводит к тому, что в ячейке устанавливается значение 1065 (т.е. в 1000 раз больше), а не 1,065. Пробовал в исходной форме сразу задавать числовой формат ячейки, пробовал ставить в разные ячейки такое значение - не помогает. Зато значение 1,07 (т.е. всего с двумя знаками после запятой в те же ячейки ставит без проблем). Вариант H2;formulaLocal;=1,065 работает адекватно и в ячейке ставится правильное значение. Десятичные разделители и разделители разрядов проверял и в Excel'е и в системе - все в полном порядке. Так и не удалось установить, почему происходит такое преобразование, которое по-видимому касается лишь чисел, у которых более двух знаков после запятой (кстати, я пробовал сразу в ячейке дать бОльшее количество знаков после запятой в исходной форме - тоже не помогло). Пробовал прерывать выполнение программы без закрытия текущей рабочей книги Excel и вводить в те же самые ячейки значение 1,065 вручную - никаких проблем. Проверял получаемое значение из текстового файла и в момент его передачи из переменной в Excel - никаких багов.
Подскажите, в чем может быть проблема?

14SatanA88

Дата 12.7.2011, 11:19 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: 2
Всего: 5

действительно, 1065 получалось...

вот так попробуй. у меня сработало

Код


procedure TForm1.Button1Click(Sender: TObject);
var excel, sheet: Variant;
begin

  Excel:=CreateOleObject('Excel.Application');
  Excel.DisplayAlerts:=false;
  Excel.Workbooks.Add;
  Excel.Visible:=false;
  Sheet:=Excel.Workbooks[1].WorkSheets[1];

  Sheet.Cells[1, 1].NumberFormat:='@';
  Sheet.Cells[1, 1].value:='1,065';
  Sheet.Cells[1, 2].NumberFormat:='@';
  Sheet.Cells[1, 2].value:='1,07';
  Sheet.Cells[1, 1].NumberFormat:='0,00';
  Sheet.Cells[1, 2].NumberFormat:='0,00';

  Excel.WorkBooks.Item[1].SaveAs('d:\lol.xls');
  Excel.Workbooks.Close;
  Excel.Application.Quit;

end;

здесь сначала устанавливается текстовый формат ячеек, затем числовой (когда значения уже внесены)

Данкинг

Дата 12.7.2011, 12:14 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 9
Всего: 130

А не проще на листе текстовый формат задавать сразу? Или же нужен именно числовой?

ЗЫ: Томилино - заколдованное место вообще: как туда не приезжаешь - постоянно дождь идёт, хотя вокруг сухо. smile

--------------------

There's nothing left but silent epitaphs.

14SatanA88

Дата 12.7.2011, 13:27 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: 2
Всего: 5

Цитата

А не проще на листе текстовый формат задавать сразу

ну это я в общем виде набросал.
я же не знаю чего топикстартер добивается конкретно

Данкинг

Дата 12.7.2011, 14:16 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 9
Всего: 130

14SatanA88, Excel:=Unassigned ещё забыл. smile

--------------------

There's nothing left but silent epitaphs.

14SatanA88

Дата 12.7.2011, 14:48 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: 2
Всего: 5

Цитата

Excel:=Unassigned ещё забыл.

ну да. реально забыл. потом процессы убивал)

Это сообщение отредактировал(а) 14SatanA88 - 12.7.2011, 14:55

Akella

Дата 12.7.2011, 16:44 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

Цитата(demoniqus @ 12.7.2011, 09:41

)

Есть код

а что, нельзя выложить только кусок проблемного кода?

14SatanA88

Дата 13.7.2011, 13:37 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: 2
Всего: 5

Цитата

а что, нельзя выложить только кусок проблемного кода?

по всей видимости, там весь код проблемный smile

а так ты прав, акелла, сразу хер поймешь, в чем дело.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »