Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.07.30;
Скачать: CL | DM;

Вниз

Получение данных из Excel через Clipboard   Найти похожие ветки 

 
_RusLAN ©   (2006-06-16 18:22) [0]

Задача: Пользователь выделяет несколько ячеек(диапазон MxN) в Excel, копирует их буфер.
Надо получить размер диапазона (количество ячеек по вертикали и горизонтали) и данные из этих ячеек.
Вопрос: Как?

Спасибо.

ЗЫ. Excel не привязан к программе через OLE, имеется доступ только к буферу Windows.


 
Black Krok ©   (2006-06-16 20:54) [1]

Нельзя быть таким ленивым :)
Скопируйте, вставьте в FAR`е(или хоть в NotePad) в какой-нить файл, посмотрите, что получится.
Содержимое столбцов разделяется TAB, строки - переносом строки


 
GanibalLector ©   (2006-06-16 23:25) [2]

Вот,примерно что-то подобное. Процедура вставки из Excel в TStringGrid


procedure PasteGrid(Grid: TStringGrid);
 var CharPos:Integer;
     Line,TempLine : string;
     Ch:Char;
     RecRow,RecCol,TmpCol:Integer;
     myRect:TGridRect;
 const EofChar = #0;
 //
 function GetClipBoard:String;
   var h:HWND;
       Ptxt:PChar;
 begin
   if OpenClipBoard(0)then
   begin
     try
       h := GetClipboardData(CF_TEXT);
       if h<>0 then
       begin
         Ptxt := GlobalLock (h);
         Result:=StrPas(Ptxt);
         GlobalUnlock(h);
       end;
     finally
       CloseClipBoard;
     end;
   end;
 end;

 procedure NextChar;
 begin
  Inc(CharPos);
  if CharPos <= Length(Line) then
   Ch := Line[CharPos] else Ch := EofChar
 end;

 function GetReturn(Line:String):Integer;
   var I:Integer;
 begin
   Result:=0;
   I:=0;
   repeat
     Inc(I);
     if (Line[I]=Chr($0D)) or (Line[I]=Chr($09))
      then Result:=Result+1;
   until (Result>=2) or (I>=Length(Line));
 end;
 //
begin
 TmpCol:=0;
 with Grid,Grid.Selection do
 begin
   RecRow:=Row;
   RecCol:=Col;
   Line:=GetClipBoard;   // !
   if GetReturn(Line)=1 then
   begin
     for RecRow:=Top to Bottom do
     for RecCol:=Left to Right do
      Cells[RecCol, RecRow] :=Copy(Line,1,Length(Line)-2);
   end else
   begin
     CharPos:=0;
     repeat
       NextChar;
       if not(Ch in [ #9,#13,#10]) then
        TempLine:=TempLine+Ch;
       if Ch=Chr($09) then
       begin
         Cells[RecCol,RecRow]:=TempLine;
         RecCol:=RecCol+1;
         TempLine:="";
       end;
       if Ch=Chr($0D) then
       begin
         Cells[RecCol,RecRow]:=TempLine;
         RecRow:=RecRow+1;
         TmpCol:=RecCol;
         RecCol:=Col;
         TempLine:="";
       end;
     until Ch=EofChar;
     with myRect do
     begin
       Left:= Col;
       Top:=  Row;
       Right:=TmpCol;
       Bottom:=RecRow-1;
     end;
     Selection:=myRect;
   end;
 end;
end;




Страницы: 1 вся ветка

Текущий архив: 2006.07.30;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.026 c
6-1142512145
Новочеркасский Волк
2006-03-16 15:29
2006.07.30
Виновата ли ADSL или в чём ошибка???


2-1152181187
Quattro
2006-07-06 14:19
2006.07.30
Ширина символа


2-1152416078
elfen_kenny
2006-07-09 07:34
2006.07.30
TIBUpdateSQL блин


1-1150382715
StriderMan
2006-06-15 18:45
2006.07.30
Скомпилировать проет в двух вариантах


3-1148377072
vigo_
2006-05-23 13:37
2006.07.30
Вопрос по компоненте TSimpleDataSet