AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Excel Rahmen zeichnen

Ein Thema von Moombas · begonnen am 22. Mär 2017 · letzter Beitrag vom 12. Apr 2017
Antwort Antwort
Seite 1 von 2  1 2      
Benutzerbild von Moombas
Moombas

Registriert seit: 22. Mär 2017
Ort: bei Flensburg
525 Beiträge
 
FreePascal / Lazarus
 
#1

Excel Rahmen zeichnen

  Alt 22. Mär 2017, 09:37
Moin zusammen,

ich habe ein kleines Problem in Delphi.

Ich mache bisher folgendes (funktioniert 1A):
- Exceldatei einlesen
- Spalten/Zeilen löschen
- Speichern
- Dann Einfärben, Schrift ändern, autoadjust

Wo ich aber partou nicht weiter komme, ist Rahmenlinien zu zeichnen. Ich habe schon einiges versucht was man so alles über die Google-Suche etc finden kann. Aber leider ohne erfolg, da ich in uses kein ExcelXP, Excel97 oder ähnliches einfügen kann.

Hängt das evtl. mit Delphi 10.1 starter zusammen?
Hat jemand eine Idee ohne die das in uses zu verwenden es hin zu bekommen?

Die Prozedur für das einfärben sieht so aus und durch die fehlende uses kennt er halt xlcontinous etc. nicht.:
Code:
//Exceldatei einfärben
procedure TMAin.Xls_To_Color(AXLSFile: string; Zeile : integer; Farbe : string; Text : integer);
const
  xlCellTypeLastCell = $0000000B;
var
  Excel, Sheet: OLEVariant;
  Puffer : string;
  Color : integer;
begin
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  if farbe = 'Weiß' then Color := 0;
  if farbe = 'Rot' then Color := 3;
  if farbe = 'Grün' then Color := 10;
  if farbe = 'Blau' then Color := 41;
  if farbe = 'Gelb' then Color := 6;
  // Create Excel-OLE Object
  Excel := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    Excel.Visible := False;
    // Open the Workbook
    Excel.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := Excel.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
    Puffer := inttostr(Zeile+1)+':'+inttostr(Zeile+1);
    Excel.Range[Puffer].Select;
    if text = 1 then Excel.Selection.Font.colorindex := Color else Excel.Selection.Interior.ColorIndex := Color;
    // Oberste Zeile Fett und Grau
    Excel.Range[inttostr(1)+':'+inttostr(1)].Select;
    Excel.Selection.Font.FontStyle := 'Bold';
    Excel.Selection.Interior.ColorIndex := 15 ;
    //Rahmen zeichnen
    Excel.Range['A1:' + 'AZ' + inttostr(Display.RowCount - 1)].select;
    //Excel.Selection.Borders[xlEdgeLeft].LineStyle := xlContinuous;
  finally
    // Save file and Quit Excel
    if not VarIsEmpty(Excel) then
    begin
      Excel.save;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
Schon mal besten Dank vorab.
  Mit Zitat antworten Zitat
nahpets
(Gast)

n/a Beiträge
 
#2

AW: Excel Rahmen zeichnen

  Alt 22. Mär 2017, 09:56
Suchst Du sowas?

 ews1.Range[sRange,sRange].BorderAround(xlContinuous,xlThin,0,0);

Ews1 ist ein ExcelWorkSheet.

sRange enthält den Namen einer Zelle, z. B.: A1.

  ews1.Range['A1','D4'].BorderAround(xlContinuous,xlThin,0,0);

Hier müsste dann ein dünner Rahmen um den Bereich der ersten vier Zeilen und der ersten vier Spalten in der Exceltabelle entstehen.
  Mit Zitat antworten Zitat
Jumpy

Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.733 Beiträge
 
Delphi 6 Enterprise
 
#3

AW: Excel Rahmen zeichnen

  Alt 22. Mär 2017, 10:11
Ein paar allgemeine Dinge, die einem das Leben da leichter machen können:
Auch für Workbook und Ranges OLEVariant-Variablen benutzen, und dann deine Formatierungen direkt auf das Range-Objekt anwenden, anstatt immer erst zu Selecten und dann an die Selection zu gehen. Spart Zeit.

Delphi-Quellcode:
procedure TMAin.Xls_To_Color(AXLSFile: string; Zeile : integer; Farbe : string; Text : integer);
const
  xlCellTypeLastCell = $0000000B;
var
  Excel, Sheet: OLEVariant;
  wb, rg: OLEVariant;
  Puffer : string;
  Color : integer;
begin
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  if farbe = 'Weißthen Color := 0;
  if farbe = 'Rotthen Color := 3;
  if farbe = 'Grünthen Color := 10;
  if farbe = 'Blauthen Color := 41;
  if farbe = 'Gelbthen Color := 6;
  // Create Excel-OLE Object
  Excel := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    Excel.Visible := False;
    // Open the Workbook
    wb := Excel.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := wb.WorkSheets[1];
    //Puffer := inttostr(Zeile+1)+':'+inttostr(Zeile+1);
    //Excel.Range[Puffer].Select;
    rg := Sheet.columns[Zeile+1].EntireColumn
    if text = 1 then rg.Font.colorindex := Color else rg.Interior.ColorIndex := Color;
    // Oberste Zeile Fett und Grau
    //Excel.Range[inttostr(1)+':'+inttostr(1)].Select;
    rg := Sheet.columns[1].EntireColumn
    rg.Font.FontStyle := 'Bold';
    rg.Interior.ColorIndex := 15 ;
    //Rahmen zeichnen
    rg=Excel.Range[Sheet.Cells(1,1),Sheet.Cells(Sheet.UsedRange.Rows.Count,26)]
    //Excel.Range['A1:' + 'AZ' + inttostr(Display.RowCount - 1)].select;
    //Excel.Selection.Borders[xlEdgeLeft].LineStyle := xlContinuous;
  finally
    // Save file and Quit Excel
    if not VarIsEmpty(Excel) then
    begin
      Excel.save;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
Excel-Konstanten wie xlContinuous einfach in Excel nachschauen, was die für einen Wert haben und dann im Programm selber als Const anlegen.
Ralph
  Mit Zitat antworten Zitat
Benutzerbild von Moombas
Moombas

Registriert seit: 22. Mär 2017
Ort: bei Flensburg
525 Beiträge
 
FreePascal / Lazarus
 
#4

AW: Excel Rahmen zeichnen

  Alt 22. Mär 2017, 10:40
Danke schon mal für beide Antworten.

@nahpets: Du arbeitest auch mit den "xlContinous", welche bei mir leider nicht funktionieren da ich in uses kein Excel einbinden kann (warum auch immer). Evtl. klappt es in Kombination mit dem Hinweis von Ralph.

@Ralph: Danke für den Hinweis, aber wie bekomme ich den Wert in Excel von den Konstanten raus? Bei den Makros haut er auch "nur" die Bezeichnung raus.

Edit: Habs raus bekommen Die Kombination von euren beiden Sachen wars.

Edit 2: Weißt einer von euch zufällig auch die Bezeichnung um die inneren Linien zu malen?

Geändert von Moombas (22. Mär 2017 um 11:02 Uhr)
  Mit Zitat antworten Zitat
nahpets
(Gast)

n/a Beiträge
 
#5

AW: Excel Rahmen zeichnen

  Alt 22. Mär 2017, 11:09
Keine Ahnung, wo ich das herhabe:
Delphi-Quellcode:
unit XLConst;

interface

const
{ XlSheetType }
  xlChart = -4109;
  xlDialogSheet = -4116;
  xlExcel4IntlMacroSheet = 4;
  xlExcel4MacroSheet = 3;
  xlWorksheet = -4167;

{ XlWBATemplate }
  xlWBATChart = -4109;
  xlWBATExcel4IntlMacroSheet = 4;
  xlWBATExcel4MacroSheet = 3;
  xlWBATWorksheet = -4167;

{ XlPattern }
  xlPatternAutomatic = -4105;
  xlPatternChecker = 9;
  xlPatternCrissCross = 16;
  xlPatternDown = -4121;
  xlPatternGray16 = 17;
  xlPatternGray25 = -4124;
  xlPatternGray50 = -4125;
  xlPatternGray75 = -4126;
  xlPatternGray8 = 18;
  xlPatternGrid = 15;
  xlPatternHorizontal = -4128;
  xlPatternLightDown = 13;
  xlPatternLightHorizontal = 11;
  xlPatternLightUp = 14;
  xlPatternLightVertical = 12;
  xlPatternNone = -4142;
  xlPatternSemiGray75 = 10;
  xlPatternSolid = 1;
  xlPatternUp = -4162;
  xlPatternVertical = -4166;

{ XlBordersIndex }
  xlInsideHorizontal = 12;
  xlInsideVertical = 11;
  xlDiagonalDown = 5;
  xlDiagonalUp = 6;
  xlEdgeBottom = 9;
  xlEdgeLeft = 7;
  xlEdgeRight = 10;
  xlEdgeTop = 8;

{ XlLineStyle }
  xlContinuous = 1;
  xlDash = -4115;
  xlDashDot = 4;
  xlDashDotDot = 5;
  xlDot = -4118;
  xlDouble = -4119;
  xlSlantDashDot = 13;
  xlLineStyleNone = -4142;

{ XlChartType }
  xlColumnClustered = 51;
  xlColumnStacked = 52;
  xlColumnStacked100 = 53;
  xl3DColumnClustered = 54;
  xl3DColumnStacked = 55;
  xl3DColumnStacked100 = 56;
  xlBarClustered = 57;
  xlBarStacked = 58;
  xlBarStacked100 = 59;
  xl3DBarClustered = 60;
  xl3DBarStacked = 61;
  xl3DBarStacked100 = 62;
  xlLineStacked = 63;
  xlLineStacked100 = 64;
  xlLineMarkers = 65;
  xlLineMarkersStacked = 66;
  xlLineMarkersStacked100 = 67;
  xlPieOfPie = 68;
  xlPieExploded = 69;
  xl3DPieExploded = 70;
  xlBarOfPie = 71;
  xlXYScatterSmooth = 72;
  xlXYScatterSmoothNoMarkers = 73;
  xlXYScatterLines = 74;
  xlXYScatterLinesNoMarkers = 75;
  xlAreaStacked = 76;
  xlAreaStacked100 = 77;
  xl3DAreaStacked = 78;
  xl3DAreaStacked100 = 79;
  xlDoughnutExploded = 80;
  xlRadarMarkers = 81;
  xlRadarFilled = 82;
  xlSurface = 83;
  xlSurfaceWireframe = 84;
  xlSurfaceTopView = 85;
  xlSurfaceTopViewWireframe = 86;
  xlBubble = 15;
  xlBubble3DEffect = 87;
  xlStockHLC = 88;
  xlStockOHLC = 89;
  xlStockVHLC = 90;
  xlStockVOHLC = 91;
  xlCylinderColClustered = 92;
  xlCylinderColStacked = 93;
  xlCylinderColStacked100 = 94;
  xlCylinderBarClustered = 95;
  xlCylinderBarStacked = 96;
  xlCylinderBarStacked100 = 97;
  xlCylinderCol = 98;
  xlConeColClustered = 99;
  xlConeColStacked = 100;
  xlConeColStacked100 = 101;
  xlConeBarClustered = 102;
  xlConeBarStacked = 103;
  xlConeBarStacked100 = 104;
  xlConeCol = 105;
  xlPyramidColClustered = 106;
  xlPyramidColStacked = 107;
  xlPyramidColStacked100 = 108;
  xlPyramidBarClustered = 109;
  xlPyramidBarStacked = 110;
  xlPyramidBarStacked100 = 111;
  xlPyramidCol = 112;
  xl3DColumn = -4100;
  xlLine = 4;
  xl3DLine = -4101;
  xl3DPie = -4102;
  xlPie = 5;
  xlXYScatter = -4169;
  xl3DArea = -4098;
  xlArea = 1;
  xlDoughnut = -4120;
  xlRadar = -4151;

{ Border }
  xlThin = 2;

{ Various Constants }
  xlAll = -4104;
  xlAutomatic = -4105;
  xlBoth = 1;
  xlCenter = -4108;
  xlChecker = 9;
  xlCircle = 8;
  xlCorner = 2;
  xlCrissCross = 16;
  xlCross = 4;
  xlDiamond = 2;
  xlDistributed = -4117;
  xlDoubleAccounting = 5;
  xlFixedValue = 1;
  xlFormats = -4122;
  xlGray16 = 17;
  xlGray8 = 18;
  xlGrid = 15;
  xlHigh = -4127;
  xlInside = 2;
  xlJustify = -4130;
  xlLightDown = 13;
  xlLightHorizontal = 11;
  xlLightUp = 14;
  xlLightVertical = 12;
  xlLow = -4134;
  xlManual = -4135;
  xlMinusValues = 3;
  xlModule = -4141;
  xlNextToAxis = 4;
  xlNone = -4142;
  xlNotes = -4144;
  xlOff = -4146;
  xlOn = 1;
  xlPercent = 2;
  xlPlus = 9;
  xlPlusValues = 2;
  xlSemiGray75 = 10;
  xlShowLabel = 4;
  xlShowLabelAndPercent = 5;
  xlShowPercent = 3;
  xlShowValue = 2;
  xlSimple = -4154;
  xlSingle = 2;
  xlSingleAccounting = 4;
  xlSolid = 1;
  xlSquare = 1;
  xlStar = 5;
  xlStError = 4;
  xlToolbarButton = 2;
  xlTriangle = 3;
  xlGray25 = -4124;
  xlGray50 = -4125;
  xlGray75 = -4126;
  xlBottom = -4107;
  xlLeft = -4131;
  xlRight = -4152;
  xlTop = -4160;
  xl3DBar = -4099;
  xl3DSurface = -4103;
  xlBar = 2;
  xlColumn = 3;
  xlCombination = -4111;
  xlCustom = -4114;
  xlDefaultAutoFormat = -1;
  xlMaximum = 2;
  xlMinimum = 4;
  xlOpaque = 3;
  xlTransparent = 2;
  xlBidi = -5000;
  xlLatin = -5001;
  xlContext = -5002;
  xlLTR = -5003;
  xlRTL = -5004;
  xlVisualCursor = 2;
  xlLogicalCursor = 1;
  xlSystem = 1;
  xlPartial = 3;
  xlHindiNumerals = 3;
  xlBidiCalendar = 3;
  xlGregorian = 2;
  xlComplete = 4;
  xlScale = 3;
  xlClosed = 3;
  xlColor1 = 7;
  xlColor2 = 8;
  xlColor3 = 9;
  xlConstants = 2;
  xlContents = 2;
  xlBelow = 1;
  xlCascade = 7;
  xlCenterAcrossSelection = 7;
  xlChart4 = 2;
  xlChartSeries = 17;
  xlChartShort = 6;
  xlChartTitles = 18;
  xlClassic1 = 1;
  xlClassic2 = 2;
  xlClassic3 = 3;
  xl3DEffects1 = 13;
  xl3DEffects2 = 14;
  xlAbove = 0;
  xlAccounting1 = 4;
  xlAccounting2 = 5;
  xlAccounting3 = 6;
  xlAccounting4 = 17;
  xlAdd = 2;
  xlDebugCodePane = 13;
  xlDesktop = 9;
  xlDirect = 1;
  xlDivide = 5;
  xlDoubleClosed = 5;
  xlDoubleOpen = 4;
  xlDoubleQuote = 1;
  xlEntireChart = 20;
  xlExcelMenus = 1;
  xlExtended = 3;
  xlFill = 5;
  xlFirst = 0;
  xlFloating = 5;
  xlFormula = 5;
  xlGeneral = 1;
  xlGridline = 22;
  xlIcons = 1;
  xlImmediatePane = 12;
  xlInteger = 2;
  xlLast = 1;
  xlLastCell = 11;
  xlList1 = 10;
  xlList2 = 11;
  xlList3 = 12;
  xlLocalFormat1 = 15;
  xlLocalFormat2 = 16;
  xlLong = 3;
  xlLotusHelp = 2;
  xlMacrosheetCell = 7;
  xlMixed = 2;
  xlMultiply = 4;
  xlNarrow = 1;
  xlNoDocuments = 3;
  xlOpen = 2;
  xlOutside = 3;
  xlReference = 4;
  xlSemiautomatic = 2;
  xlShort = 1;
  xlSingleQuote = 2;
  xlStrict = 2;
  xlSubtract = 3;
  xlTextBox = 16;
  xlTiled = 1;
  xlTitleBar = 8;
  xlToolbar = 1;
  xlVisible = 12;
  xlWatchPane = 11;
  xlWide = 3;
  xlWorkbookTab = 6;
  xlWorksheet4 = 1;
  xlWorksheetCell = 3;
  xlWorksheetShort = 5;
  xlAllExceptBorders = 6;
  xlLeftToRight = 2;
  xlTopToBottom = 1;
  xlVeryHidden = 2;
  xlDrawingObject = 14;
  
implementation

end.
Schmort zusammen mit Uraltsoftware auf meiner Festplatte rum. Ist mindestens 15 Jahre alt.

Mehr findest Du eventuell hier: https://www.benefind.de/web.php?org=...l+xlContinuous
  Mit Zitat antworten Zitat
Benutzerbild von Moombas
Moombas

Registriert seit: 22. Mär 2017
Ort: bei Flensburg
525 Beiträge
 
FreePascal / Lazarus
 
#6

AW: Excel Rahmen zeichnen

  Alt 22. Mär 2017, 11:18
Danke dafür, habs nun aber über eine Schleife gelöst XD Vielleicht nicht das schönste aber es funktioniert. Für mich als Hobbyprogrammierer reichts aus^^

Edit: Ohne Schleife geht es auch so:

Delphi-Quellcode:
    Puffer := '1:'+ inttostr(TStringgrid.RowCount - 1);
    Excel.Range[Puffer].Borders[11].LineStyle := 1;
    Excel.Range[Puffer].Borders[11].Weight := 2;
    Excel.Range[Puffer].Borders[12].LineStyle := 1;
    Excel.Range[Puffer].Borders[12].Weight := 2;

Geändert von Moombas (22. Mär 2017 um 13:08 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Moombas
Moombas

Registriert seit: 22. Mär 2017
Ort: bei Flensburg
525 Beiträge
 
FreePascal / Lazarus
 
#7

AW: Excel Rahmen zeichnen

  Alt 22. Mär 2017, 19:02
So, nun bin ich beim nächsten Problem

Das Sortieren in Excel über Delphi, habe bisher folgendes gefunden (wie gesagt weiterhin leider ohne Excel-Unit):
Delphi-Quellcode:
sheet.Range['A1', 'I10'].Sort(sheet.Range['A1', 'A10'],
    xlAscending, EmptyParam, EmptyParam, xlDescending,
    EmptyParam, xlAscending, xlNo, EmptyParam,
    True, xlTopToBottom, xlSyllabary);
Aber irgendwie passiert garnichts, wobei ich xlAscending = 1 vordefiniere (hatte das irgendwo gefunden) und xlDescending durch xlAscending ersetze, da ich erstmal überhaupt sehen wollte das sich was tut, aber nix geändert. Die Zellen ahbe ich fix gelassen zum testen, werden später richtig/dynamisch definiert.
  Mit Zitat antworten Zitat
Jumpy

Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.733 Beiträge
 
Delphi 6 Enterprise
 
#8

AW: Excel Rahmen zeichnen

  Alt 23. Mär 2017, 08:53
@Ralph: Danke für den Hinweis, aber wie bekomme ich den Wert in Excel von den Konstanten raus? Bei den Makros haut er auch "nur" die Bezeichnung raus.
nahpets Liste hilft da ja schon und enthält auch das Wichtigste. Grundsätzlich kann man in Excel entweder auch in die Hilfe gucken, da kommt man dann auch an die Infos über Aufzählungen und Konstanten. Oder aber im VBA-Editor auch so eine Konstante gehen und F2 (meine ich?) drücken, oder rechte Maustaste "Definition".
Ralph
  Mit Zitat antworten Zitat
Jumpy

Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.733 Beiträge
 
Delphi 6 Enterprise
 
#9

AW: Excel Rahmen zeichnen

  Alt 23. Mär 2017, 08:56
Hier mal ein VBA-Code von mir, mit dem ich sortiere. Den kannst du vllt. auch nach Delphi übersetzen:

Code:
Public Sub SortObjekts_ID()
  Dim w As Worksheet, ws As Worksheet
  Application.ScreenUpdating = False
  Set w = ThisWorkbook.Worksheets(Konfig.Sheetname_Objekte)
  w.Sort.SortFields.Clear
  w.Sort.SortFields.Add Key:=Range("A2:A" & w.UsedRange.Rows.Count), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  w.Sort.SetRange Range("A1:C" & w.UsedRange.Rows.Count)
  w.Sort.Header = xlYes
  w.Sort.MatchCase = False
  w.Sort.Orientation = xlTopToBottom
  w.Sort.SortMethod = xlPinYin
  w.Sort.Apply
  Application.ScreenUpdating = True
End Sub
Ralph
  Mit Zitat antworten Zitat
Benutzerbild von Moombas
Moombas

Registriert seit: 22. Mär 2017
Ort: bei Flensburg
525 Beiträge
 
FreePascal / Lazarus
 
#10

AW: Excel Rahmen zeichnen

  Alt 23. Mär 2017, 15:01
@Ralph: Danke für den Hinweis, aber wie bekomme ich den Wert in Excel von den Konstanten raus? Bei den Makros haut er auch "nur" die Bezeichnung raus.
nahpets Liste hilft da ja schon und enthält auch das Wichtigste. Grundsätzlich kann man in Excel entweder auch in die Hilfe gucken, da kommt man dann auch an die Infos über Aufzählungen und Konstanten. Oder aber im VBA-Editor auch so eine Konstante gehen und F2 (meine ich?) drücken, oder rechte Maustaste "Definition".
Moin Ralph, danke dafür, hatte sich aber angefunden

Nach dem ich nun viel hin und her probiert habe mit dem sortieren, habe ich es nun verworfen, da dies "nur" optional ist. Allerdings bin ich aktuell über ein wirklich gravierendes Problem gestolpert. Er generiert zur Laufzeit teilweise ettliche *tmp Dateien und ich finde die Ursache nicht, Vermute sie aber im Zusammenhang mit Excel, denn früher hatte ich solche Probleme nie (habe da nicht direkt mit einem externen Programm gearbeitet). Vielleicht hat jemand von euch eine Idee:

Delphi-Quellcode:
//Excel einlesen
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;
  // Create Excel-OLE Object
  XLApp := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    XLApp.Visible := False;
    // Open the Workbook
    XLApp.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
    // In order to know the dimension of the WorkSheet, i.e the number of rows
    // and the number of columns, we activate the last non-empty cell of it
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
    // Get the value of the last row
    x := XLApp.ActiveCell.Row;
    // Get the value of the last column
    y := XLApp.ActiveCell.Column;
    // Set Stringgrid's row &col dimensions.
    AGrid.RowCount := x;
    AGrid.ColCount := y;
    // Assign the Variant associated with the WorkSheet to the Delphi Variant
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    // Define the loop for filling in the TStringGrid
    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;
    // Unassign the Delphi Variant Matrix
    RangeMatrix := Unassigned;
  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      // XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
    end;
  end;
end;
//Excel einfärben
procedure TMAin.Xls_To_Color(AXLSFile: string; Zeile : integer; Farbe : string; Text : integer);
const
  xlCellTypeLastCell = $0000000B;
var
  Excel, Sheet: OLEVariant;
  Puffer : string;
  Color : integer;
begin
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  if farbe = 'Weißthen Color := 0;
  if farbe = 'Rot'  then Color := 3;
  if farbe = 'Grünthen Color := 10;
  if farbe = 'Blauthen Color := 41;
  if farbe = 'Gelbthen Color := 6;
  // Create Excel-OLE Object
  Excel := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    Excel.Visible := False;
    // Open the Workbook
    Excel.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := Excel.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

    Puffer := inttostr(Zeile+1)+':'+inttostr(Zeile+1);
    if text = 1 then Excel.Selection.Range[Puffer].colorindex := Color else Excel.Range[Puffer].Interior.ColorIndex := Color;
  finally
    // Save file and Quit Excel
    if not VarIsEmpty(Excel) then
    begin
      Excel.save;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
//Excel Raster zeichnen
procedure TMAin.Xls_Grid(AXLSFile: string);
const
  xlCellTypeLastCell = $0000000B;
var
  Excel, Sheet: OLEVariant;
  Puffer : string;
begin
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  // Create Excel-OLE Object
  Excel := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    Excel.Visible := False;
    // Open the Workbook
    Excel.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := Excel.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

    // Oberste Zeile Fett und Grau
    Excel.Range[inttostr(1)+':'+inttostr(1)].Font.FontStyle := 'Bold';
    Excel.Range[inttostr(1)+':'+inttostr(1)].Interior.ColorIndex := 15 ;
    //Rahmen zeichnen
    Puffer := '1:'+ inttostr(Display.RowCount - 1);
    Excel.Range[Puffer].Borders[11].LineStyle := 1;
    Excel.Range[Puffer].Borders[11].Weight := 2;
    Excel.Range[Puffer].Borders[12].LineStyle := 1;
    Excel.Range[Puffer].Borders[12].Weight := 2;
    Excel.Range[inttostr(1)+':'+inttostr(1)].BorderAround(11,3,0,0);
  finally
    // Save file and Quit Excel
    if not VarIsEmpty(Excel) then
    begin
      Excel.save;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
oder hier:

Delphi-Quellcode:
  try
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  {create variant array where we'll copy our data}
  RowCount := Display.RowCount;
  ColCount := Display.ColCount;
  arrData := VarArrayCreate([1, RowCount, 1, ColCount], varVariant);
  {fill array}
  for i := 1 to RowCount do
    for j := 1 to ColCount do
      arrData[i, j] := Display.Cells[j-1, i-1];
  {initialize an instance of Excel}
  xls := CreateOLEObject('Excel.Application');
  {create workbook}
  wb := xls.Workbooks.Add;
  {retrieve a range where data must be placed}
  Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1, 1], wb.WorkSheets[1].Cells[RowCount, ColCount]];
  {copy data from allocated variant array}
  Range.Value := arrData;
  {show Excel with our data}
  xls.Visible := False;
  deletefile(neuedatei);
  xls.Range['A1', 'ZZ9999'].EntireColumn.Autofit;
  xls.Application.Workbooks[1].SaveAs(neuedatei);
  finally
    // Save file and Quit Excel
  if not VarIsEmpty(xls) then
    begin
      xls.save;
      xls.Quit;
      xls := Unassigned;
      wb := Unassigned;
    end;
  end;

Geändert von Moombas (24. Mär 2017 um 08:19 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:18 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz