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;
String < > Excel or Word
Abonnieren
Posts (Atom)
Beliebte Posts
-
Network Source Code Update Source Code Network Update : https://asciigen.blogspot.com/p/network.html Send Message 1.0 Source Server Client ...
-
Windows Key Sniffer 0.82 - Update 08/2024 Der Windows Key Sniffer hat mir im Laufe der Zeit viel Arbeit erspart und unterstützt, viele Wi...
-
Windows Defender Bypass Version 0.75 - Update 11/2024 Den Windows 10-eigenen Virenschutz Defender kann man auf mehreren Wegen abschalten,...
-
ASCii GIF Animator Update Version 0.68 (32 bit) - 11/2024 Bei dieser überarbeiteten Version ist die Kompatibilität zu den verschiedenen GIF...
-
MD5 Hacker v.0.26 - Update 08.2024 MD5 Hashs sollten eigentlich nicht entschlüsselt werden können. Jedoch gibt es Tools, mit welchen auch ...
-
Host Editor Version 0.64 - Update 11/2024 Hosts File Editor allows for the easy editing of host files and backup creation. Create your own h...
-
Dir Sniffer Version 0.08 - Update 08/2024 Dir Sniffer ist ein kleines aber nützliches Tool um herauszufinden, was ihr Programm auf ihrem...
-
Oldskool Font Generator v.0.29 - Update 11/2023 Das Tool stell 508 Bitmap Fonts zu Verfügung. Eigene Fonts können integriert werden, sie...
-
ASCii Text Creator v.0.24 - Update 11.2023 * Add BugFix Gui Move Message Send * Add 447 Figlet Font Pack * Fixed Invert Unicode Function * ...
Keine Kommentare:
Kommentar veröffentlichen