1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133:
| uses ComObj;
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;
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 SheetCount := (Grid.ColCount div 256) + 1; if Grid.ColCount mod 256 = 0 then SheetCount := SheetCount - 1; BookCount := (Grid.RowCount div 65536) + 1; if Grid.RowCount mod 65536 = 0 then BookCount := BookCount - 1;
Result := False; XLApp := CreateOleObject('Excel.Application'); try if ShowExcel = false then XLApp.Visible := False else XLApp.Visible := True; for M := 1 to BookCount do begin XLApp.Workbooks.Add(xlWBATWorksheet); for N := 1 to SheetCount - 1 do begin XLApp.Worksheets.Add; end; end; if Grid.ColCount <= 256 then SheetColCount := Grid.ColCount else SheetColCount := 256; if Grid.RowCount <= 65536 then SheetRowCount := Grid.RowCount else SheetRowCount := 65536;
for M := 1 to BookCount do begin for N := 1 to SheetCount do begin 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); XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)].Select; XLApp.Selection.NumberFormat := '@'; XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select; Sheet := XLApp.Workbooks[M].WorkSheets[N]; Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Value := Data; end; end; 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 end; finally if (not VarIsEmpty(XLApp)) and (ShowExcel = false) then begin XLApp.DisplayAlerts := False; XLApp.Quit; XLAPP := Unassigned; Sheet := Unassigned; end; end; end;
procedure TForm1.Button1Click(Sender: TObject); begin StringGridToExcelSheet(StringGrid, 'Stringgrid Print', 'c:\Test\ExcelFile.xls',True); end; |