this slowpoke moves

String < > Excel or Word

uses Grids, Excel2000, OleServer, ExcelXP, ComObj, ComCtrls, WordXP

//

// speicher funktion
procedure SaveGrid(StringGrid1: TStringGrid; fileName: string); 
var 
  iRow: integer; 
  sl: TStringList; 
begin 
  sl := TStringList.Create; 
  for iRow := 0 to StringGrid1.RowCount - 1 do
    sl.Add(StringGrid1.Rows[iRow].CommaText);
  sl.SaveToFile(fileName);
  sl.Free;
end; 

// ########################## laden in container
 function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
  xlCellTypeLastCell = $0000000B;
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  x, y, k, r: Integer;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    XLApp.Visible := False;
    XLApp.Workbooks.Open(AXLSFile);
    Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;
    AGrid.RowCount := x;
    AGrid.ColCount := y;
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    repeat
      for r := 1 to y do
        AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
      Inc(k, 1);
      AGrid.RowCount := k + 1;
    until k > x;
    RangeMatrix := Unassigned;
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
    end;
  end;
end;

// ########################### speichern auf c:\
function RefToCell(RowID, ColID: Integer): string;
var
  ACount, APos: Integer;
begin
  ACount := ColID div 26;
  APos   := ColID mod 26;
  if APos = 0 then
  begin
    ACount := ACount - 1;
    APos   := 26;
  end;

  if ACount = 0 then
     Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
  if ACount = 1 then
     Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
  if ACount > 1 then
     Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) +
     IntToStr(RowID);
end;

//StringGrid-Inhalt nach Excel exportieren
function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
  ShowExcel: Boolean): Boolean;
const
  xlWBATWorksheet = -4167;
var
  SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
  XLApp, Sheet, Data: OLEVariant;
  I, J, N, M: Integer;
  SaveFileName : String;
begin
  //notwendige Sheetanzahl feststellen
  SheetCount := (Grid.ColCount div 256) + 1;
  if Grid.ColCount mod 256 = 0 then
     SheetCount := SheetCount - 1;
  //notwendige Bookanzahl feststellen
  BookCount := (Grid.RowCount div 65536) + 1;
  if Grid.RowCount mod 65536 = 0 then
     BookCount := BookCount - 1;
  //Create Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    //Excelsheet anzeigen
    if ShowExcel = false then
       XLApp.Visible := False
    else
       XLApp.Visible := True;
    //Workbook hinzufügen
    for M := 1 to BookCount do
    begin
        XLApp.Workbooks.Add(xlWBATWorksheet);
        //Sheets anlegen
        for N := 1 to SheetCount - 1 do
        begin
          XLApp.Worksheets.Add;
        end;
    end;
    //Sheet ColAnzahl feststellen
    if Grid.ColCount <= 256 then
       SheetColCount := Grid.ColCount
    else
       SheetColCount := 256;
    //Sheet RowAnzahl feststellen
    if Grid.RowCount <= 65536 then
       SheetRowCount := Grid.RowCount
    else
       SheetRowCount := 65536;
    //Sheets befüllen
    for M := 1 to BookCount do
    begin
        for N := 1 to SheetCount do
        begin
          //Daten aus Grid holen
          Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
          for I := 0 to SheetColCount - 1 do
            for J := 0 to SheetRowCount - 1 do
              if ((I+256*(N-1)) <= Grid.ColCount) and ((J+65536*(M-1)) <= Grid.RowCount) then
                Data[J + 1, I + 1] := Grid.Cells[I+256*(N-1), J+65536*(M-1)];

          XLApp.Worksheets[N].Select;
          XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
          //Zellen als String Formatieren
          XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1), RefToCell(SheetRowCount,
            SheetColCount)].Select;
          XLApp.Selection.NumberFormat := '@';
          XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
          //Daten dem Excelsheet übergeben
          Sheet := XLApp.Workbooks[M].WorkSheets[N];
          Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Value := Data;
        end;
    end;
    //Save Excel Worksheet
    try
      for M := 1 to BookCount do
      begin
          SaveFileName := Copy(FileName,1,Pos('.',FileName)-1) + IntToStr(M) +
          Copy(FileName,Pos('.',FileName),
          Length(FileName)-Pos('.',FileName)+1);
          XLApp.Workbooks[M].SaveAs(SaveFileName);
      end;
      Result := True;
    except
      // Error?
    end;
  finally
    //Excel beenden
    if (not VarIsEmpty(XLApp)) and (ShowExcel = false) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
// speichern auf c:\
procedure TForm1.Button1Click(Sender: TObject);
begin
  StringGridToExcelSheet(StringGrid1,
                        'Stringgrid Print',
                        'c:\Pr.Mappe.xls',True);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  Xls_To_StringGrid(StringGrid1, OpenDialog1.FileName);
end;

// speichere xls oder doc
procedure TForm1.Button4Click(Sender: TObject);
VAR Dateiname:string;
begin
if SaveDialog1.Execute then
  begin
    Dateiname := SaveDialog1.FileName;
    SaveGrid(Stringgrid1,Dateiname);
  end;
end; 

procedure TForm1.Button3Click(Sender: TObject);
var
  WordApp, NewDoc, WordTable: OLEVariant;
  iRows, iCols, iGridRows, jGridCols: Integer;
begin
  try
    // Create a Word Instance
    // Word Instanz erzeugen
    WordApp := CreateOleObject('Word.Application');
  except
    // Error...
    // Fehler....
    Exit;
  end;

  // Show Word
  // Word anzeigen
  WordApp.Visible := True;

  // Add a new Doc
  // Neues Dok einfügen
  NewDoc := WordApp.Documents.Add;

  // Get number of columns, rows
  // Spalten, Reihen ermitteln
  iCols := StringGrid1.ColCount;
  iRows := StringGrid1.RowCount;

  // Add a Table
  // Tabelle einfügen
  WordTable := NewDoc.Tables.Add(WordApp.Selection.Range, iCols, iRows);

  // Fill up the word table with the Stringgrid contents
  // Tabelle ausfüllen mit Stringgrid Daten
  for iGridRows := 1 to iRows do
    for jGridCols := 1 to iCols do
      WordTable.Cell(iGridRows, jGridCols).Range.Text :=
        StringGrid1.Cells[jGridCols - 1, iGridRows - 1];

  // Here you might want to Save the Doc, quit Word...
  // Hier evtl Word Doc speichern, beenden...

  // ...
  
  // Cleanup...
  WordApp := Unassigned;
  NewDoc := Unassigned;
  WordTable := Unassigned;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate