Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2006.07.30;
Скачать: [xml.tar.bz2];

Вниз

Получение данных из 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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.013 c
15-1152085173
unknown
2006-07-05 11:39
2006.07.30
Delphi Roadmap


1-1150542142
leonidus
2006-06-17 15:02
2006.07.30
Подскажите аналог chr созвращающий WideChar


2-1152603329
levin_610
2006-07-11 11:35
2006.07.30
registraciia servisov


11-1130966214
NORDmen
2005-11-03 00:16
2006.07.30
run-time packages&amp;kol


2-1152527968
Milashka
2006-07-10 14:39
2006.07.30
Boolean-поля в InterBase





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский