如何根据EXCEL中某个格的内容调整该格的大小?(50分)

  • 主题发起人 主题发起人 honestman
  • 开始时间 开始时间
H

honestman

Unregistered / Unconfirmed
GUEST, unregistred user!
var
APP_Excel: OleVariant;
WorkBook: OleVariant;
begin
APP_Excel := CreateOleObject('Excel.Application');
WorkBook := APP_Excel.Workbooks.Add;
workbook.worksheets[1].cells[1,1].value:='大富翁论坛';
......
end;

如何根据workbook.worksheets[1].cells[1,1]中的内容调整
workbook.worksheets[1].cells[1,1]的宽度和高度?
 
Columns("A:A").ColumnWidth = 17.25
Rows("1:1").RowHeight = 24
 
to arm:
  我想知道的是这个17.25和24是怎样得出来的?
  '大富翁论坛'的宽度就是17.25吗?
  如果是,又是怎样得出来的?
 
只是一个随意添的数
你可以算出字符的个数
以及每个字符在EXCEL中的宽度
 
to arm:
  算法思路我知道,我只是不知道究竟怎样实现你所说的东西。
 
一个小写的字母的宽度大约为 0.85
一个大写的字母的宽度大约为 1。38
一个汉字的宽度大约为 1。88(宋体 12号)
 
有没有效率高,而且比较准确的算法啊?这些“大概”当字符超过100个的时候精度可以
认为是不能接受的。
 
请继续或结束
 
要算出字符串的长度要知道其字体(包括大小、粗体、斜体),然后用GetTextExtentPoint32
函数得起宽度。
前两天我刚做出来一个:

function GetTextWidth(const AFont:TFont;const AStr:String):Integer; //单位是象素。
你还要根据word 或excel的单位来换算。

function CreateFont(const Font:TFont):Integer;
var
LogFont: TLogFont;
Handle : Integer;
begin
with LogFont do
begin
lfHeight := Font.Height;
lfWidth := 0; { have font mapper choose }
lfEscapement := 0; { only straight fonts }
lfOrientation := 0; { no rotation }
if fsBold in Font.Style then
lfWeight := FW_BOLD
else
lfWeight := FW_NORMAL;
lfItalic := Byte(fsItalic in Font.Style);
lfUnderline := Byte(fsUnderline in Font.Style);
lfStrikeOut := Byte(fsStrikeOut in Font.Style);
lfCharSet := Byte(Font.Charset);
if AnsiCompareText(Font.Name, 'Default') = 0 then // do not localize
StrPCopy(lfFaceName, DefFontData.Name)
else
StrPCopy(lfFaceName, Font.Name);
lfQuality := DEFAULT_QUALITY;
{ Everything else as default }
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
case Font.Pitch of
fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
fpFixed: lfPitchAndFamily := FIXED_PITCH;
else
lfPitchAndFamily := DEFAULT_PITCH;
end;
Handle := CreateFontIndirect(LogFont);
end;
Result:=Handle;
end;

function GetTextWidth(const AFont:TFont;const AStr:String):Integer;
var
TextM:TTextMetric;
dc :Integer;
a :Integer;
sz: tsize;
begin
Result:=0;
if Length(AStr)=0 then Exit;
dc:= CreateDC('DISPLAY',nil,nil,0);
try
a:=CreateFont(AFont);
SelectObject(dc,a);
try
GetTextMetrics(dc,textm);
GetTextExtentPoint32(dc,Pchar(AStr),Length(AStr),sz);
Result := sz.cx;
finally
DeleteObject(a);
end;
finally
DeleteDC(dc);
end;
end;

 
没有那么麻烦,在VBA中有一个方法,可自动根据单元格的内容调整其大小。
在此句后加上:
workbook.worksheets[1].cells[1,1].value:='大富翁论坛';
workbook.worksheets[1].cols[1].autofit;
应该注意的是,在自动调整时,只可以调整某行的高度(rows)和某列的宽度(cols)
不能调整某单元格,这是Excel中规定的。
 
!我保证你们看到以下的用法一定爽歪歪了!!!
这可是我三天工作的结果。唔。。。
---看最后终结者office。
--------------------------------
如果你们用的office97的server控件,那么用office2000时就要把server上的控件换掉。
做法:
1。在Componet里打开Install Packages.....
2.去掉borland sample automation server components
3.在project中点input type Library....
4.点add加入office2000的类库。(在Microsoft Office/office目录下的)
5。反正是什么Excel9.olb , Msword9.olb 和那些*.olb的东东,有excel的,word的,等。。。
6。palette page:改为servers(因为以前的office的控件完完了)
7。点install就好了。
这样office2000的问题我想应解决了。(如果你用的是什么word.application或excel.application 的控件的话)。
-----------
我的建议:
先用上面一的方法,再用comobj对象。
use comobj, excel_tlb; //excel_tlb 是新excel控件的pas文件,你把新控件放在窗体上看它用的哪个.pas就好了,当然下面要把这个控件去掉。因为comobj不用这个控件。只用这个.pas如excel_tlb中的函数。
var xl:variant;
在事件里写:
xl:=createoleobject('Excel.Application');

然后打开excel或word录一个宏命令,并打开宏命令考入代码。
----以下是宏录下来的宏。
workbooks.add
Range("C5:D7").Select
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sheet3").Range("A1")
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet3"
-------
现在把它改为以下:
xl.workbooks.add;
xl.Range['C5:D7'].Select;
xl.Sheets['Sheet2'].Select;
xl.ActiveWindow.SelectedSheets.Delete;
xl.Charts.Add;
xl.ActiveChart.ChartType := xlColumnClustered;
xl.ActiveChart.Location(xlLocationAsObject,'Sheet3');
现在运行一下,我保证你们爽歪歪!
看到规律了吗?
前面加上对象名,()改[],= 改:=,有参数时直接用,后加; 。哈哈,满意了吧,
用office的宏命令可是不用你去想编程的,全是手动。这样少写了一大堆代码。

bbcoll 如有不明白的朋友讨论可:bbcoll@china.com

-------------------------------------------------------
 
多人接受答案了。
 
后退
顶部