Zarejestruj makro w VBA, rób to co potrzebujesz, potem zobacz na kod makra. Zobacz też kod poniżej. Procedurka robi ramkę, zmienia kolor, rozmiar, centrowanie itp.
procedure TMain.btExportClick(Sender: TObject);
var
lcid :Integer;
VarArr :Variant;
i, j :Byte;
k, w :Byte;
v :single;
s :string;
begin
try
lcid := GetUserDefaultLCID();
xlApp.Visible[lcid] := True;
xlApp.ScreenUpdating[lcid] := False;
xlApp.DisplayAlerts[lcid] := false;
xlWB.ConnectTo(xlApp.Workbooks.Add(EmptyParam, lcid));
xlWS.ConnectTo(xlWB.Worksheets[1] as _Worksheet);
xlWS.Name := 'Tabela kątów';
// ustawienia wydruku
with xlWS.PageSetup do
begin
Orientation := xlLandScape;
CenterHorizontally := true;
CenterVertically := true;
PaperSize := xlPaperA4;
Zoom := False;
FitToPagesWide := 1;
FitToPagesTall := 1;
end;
with SG do
begin
k := ColCount;
w := RowCount;
VarArr := VarArrayCreate([1, w, 1, k], varVariant);
for i := 1 to w do
for j := 1 to k do
begin
s := Cells[j - 1, i - 1];
if TryStrToFloat(s, v) then
VarArr[i, j] := v else
VarArr[i, j] := s
end;
end;
// kopiowanie tabeli
with xlWS.Range[xlWS.Cells.Item[2,1], xlWS.Cells.Item[w+1, k]] do
begin
Value2 := VarArr;
Font.ColorIndex := 16;
Font.Italic := True;
FormatConditions.Delete;
FormatConditions.Add(xlCellValue, xlBetween,
(FloatToStr(MinA)),
(FloatToStr(MaxA)));
FormatConditions[1].Interior.ColorIndex := 8;
FormatConditions[1].Font.Bold := True;
FormatConditions[1].Font.ColorIndex := 0;
Columns.HorizontalAlignment := xlCenter;
// obramowanie
Borders[xlEdgeLeft].LineStyle := xlContinuous;
Borders[xlEdgeTop].LineStyle := xlContinuous;
Borders[xlEdgeBottom].LineStyle := xlContinuous;
Borders[xlEdgeRight].LineStyle := xlContinuous;
Borders[xlInsideVertical].LineStyle := xlContinuous;
Borders[xlInsideHorizontal].LineStyle := xlContinuous;
end;
// cell formating
with xlWS.Range[xlWS.Cells.Item[3,2], xlWS.Cells.Item[w+1, k-1]] do
begin
NumberFormat := '0'+DecimalSeparator+'00';
end;
// title
with xlWS.Range[xlWS.Cells.Item[1,1], xlWS.Cells.Item[1, k]] do
begin
Merge(xlCenter);
Cells.HorizontalAlignment := xlCenter;
Cells.ColumnWidth := Length(SG.Cells[1,1]);
Cells.Item[1,1] := cbPartNames.Text;
Font.Size := 18;
end;
// fixed col left
with xlWS.Range[xlWS.Cells.Item[2,1], xlWS.Cells.Item[w+1, 1]] do
begin
Interior.ColorIndex := 15;
Interior.Pattern := xlSolid;
Font.Bold := True;
Font.Italic := False;
Font.ColorIndex := 0;
end;
// fixed col rght
with xlWS.Range[xlWS.Cells.Item[2,k], xlWS.Cells.Item[w+1, k]] do
begin
Interior.ColorIndex := 15;
Interior.Pattern := xlSolid;
Font.Bold := True;
Font.Italic := False;
Font.ColorIndex := 0;
end;
// fixed row
with xlWS.Range[xlWS.Cells.Item[2,1], xlWS.Cells.Item[2, k]] do
begin
Interior.ColorIndex := 15;
Interior.Pattern := xlSolid;
Font.Bold := True;
Font.Italic := False;
Font.ColorIndex := 0;
end;
// autor
with xlWS.Range[xlWS.Cells.Item[w+1,1], xlWS.Cells.Item[w+1, k]] do
begin
if edExecutor.Text = '' then
Cells.Item[1,1] := 'Opracował:'+StringOfChar(' ', 20)+
' Dnia: '+DateToStr(Now())
else
Cells.Item[1,1] := 'Opracował: <'+edExecutor.Text+
'>, Dnia: '+DateToStr(Now());
Merge(xlCenter);
Cells.HorizontalAlignment := xlRight;
end;
xlApp.ScreenUpdating[lcid] := True;
xlApp.DisplayAlerts[lcid] := true;
xlWS.Disconnect();
xlWB.Disconnect();
xlApp.Disconnect();
except
MessageBox(Main.Handle,
'Błąd połączenia z MS Excel / '#13+
'MS Excel connection error',
'Error',
MB_OK or MB_ICONERROR);
end;
end;