This commit is contained in:
csh 2024-02-05 16:15:22 +08:00
parent 6d6281229c
commit 1231868aa7
5 changed files with 100 additions and 118 deletions

View File

@ -1,4 +1,4 @@
// Version 1.5.9 // Version 1.6.0
Function TOfficeObj(n); Function TOfficeObj(n);
Begin Begin
case lowercase(n) of case lowercase(n) of

View File

@ -1,4 +1,4 @@
// Version 1.5.9 // Version 1.6.0
Type TSDocxFile = Class Type TSDocxFile = Class
///Version: V1.0 2022-09-20 ///Version: V1.0 2022-09-20
///适用于 Microsoft Word docx格式文件 ///适用于 Microsoft Word docx格式文件

View File

@ -1,4 +1,4 @@
// Version 1.5.9 // Version 1.6.0
Type TSXlsxFile = Class Type TSXlsxFile = Class
///Version: V1.0 2022-08-08 ///Version: V1.0 2022-08-08
///适用于 Microsoft Excel? 2007 及以上版本创建的电子表格文档。支持 XLSX / XLSM / XLTM / XLTX 等多种文档格式。 ///适用于 Microsoft Excel? 2007 及以上版本创建的电子表格文档。支持 XLSX / XLSM / XLTM / XLTX 等多种文档格式。
@ -334,9 +334,11 @@ Type TSXlsxFile = Class
colNum ++; colNum ++;
End; End;
for i:=0 to length(data)-1 do Begin for i:=0 to length(data)-1 do Begin
for j:=0 to length(data[i])-1 do Begin j := 0;
for k, v in data[i] do Begin
[err, cell] := CoordinatesToCellName(colNum + j, rowNum + i); [err, cell] := CoordinatesToCellName(colNum + j, rowNum + i);
ret := SetCellValue(sheet, cell, data[i][j]); j++;
ret := SetCellValue(sheet, cell, v);
if not ret then return array(1, "error") if not ret then return array(1, "error")
End; End;
End; End;

View File

@ -245,7 +245,22 @@ Type xlsxWorkBook = Class
Begin Begin
//设置docProps/app.xml //设置docProps/app.xml
app := GetXmlFileObj(class(TSXml).GetFileName('docProps_app')); app := GetXmlFileObj(class(TSXml).GetFileName('docProps_app'));
vector := class(TSXml).GetNode(app, 'Properties/TitlesOfParts/vt:vector'); properties_node := app.FirstChildElement('Properties');
// HeadingPairs
variant_node := class(TSXml).GetNode(properties_node, 'HeadingPairs/vt:vector/vt:variant');
while ifObj(variant_node) do
begin
vt_node := variant_node.FirstChildElement('vt:i4');
if ifObj(vt_node) then
begin
vt_node.SetValue(length(sheetNames_) + 1);
break;
end
variant_node := variant_node.NextElement();
end
// TitlesOfParts
vector := class(TSXml).GetNode(properties_node, 'TitlesOfParts/vt:vector');
vector.SetAttribute('size', length(sheetNames_) + 1); vector.SetAttribute('size', length(sheetNames_) + 1);
vector.InsertEndChild('element', 'vt:lpstr', sheet); vector.InsertEndChild('element', 'vt:lpstr', sheet);
End; End;
@ -257,6 +272,64 @@ Type xlsxWorkBook = Class
class(TSXml).AddOverrideContentType(content_xml, '/' + fname, class(TSXml).GetTemplate('sheetContentType')); class(TSXml).AddOverrideContentType(content_xml, '/' + fname, class(TSXml).GetTemplate('sheetContentType'));
End; End;
Function insertWorkbookSheet(targetSheetName, newSheetName, sheetId, rId, direction);
Begin
workbook := GetXmlFileObj('xl/workbook.xml');
node := class(TSXml).GetNode(workbook, 'workbook/sheets');
sheet_node := node.FirstChildElement('sheet');
while ifObj(sheet_node) do
begin
if sheet_node.GetAttribute('name') = targetSheetName then
begin
if direction = "after" then
sheet_node := node.InsertAfterChild(sheet_node, 'element', 'sheet');
else
sheet_node := node.InsertBeforeChild(sheet_node, 'element', 'sheet');
sheet_node.SetAttribute('name', newSheetName);
sheet_node.SetAttribute('sheetId', sheetId);
sheet_node.SetAttribute('r:id', rid);
break;
end
sheet_node := sheet_node.NextElement();
end
End;
Function insertDocPropsApp(targetSheetName, newSheetName, direction);
Begin
//设置docProps/app.xml
app := GetXmlFileObj(class(TSXml).GetFileName('docProps_app'));
properties_node := app.FirstChildElement('Properties');
// HeadingPairs
variant_node := class(TSXml).GetNode(properties_node, 'HeadingPairs/vt:vector/vt:variant');
while ifObj(variant_node) do
begin
vt_node := variant_node.FirstChildElement('vt:i4');
if ifObj(vt_node) then
begin
vt_node.SetValue(length(sheetNames_) + 1);
break;
end
variant_node := variant_node.NextElement();
end
// TitlesOfParts
vector := class(TSXml).GetNode(properties_node, 'TitlesOfParts/vt:vector');
vector.SetAttribute('size', length(sheetNames_) + 1);
lpstr := vector.FirstChildElement('vt:lpstr');
while ifObj(lpstr) do
begin
if LowerCase(lpstr.GetText()) = LowerCase(targetSheetName) then
begin
if direction = 'after' then
lpstr := vector.InsertAfterChild(lpstr, 'element', 'vt:lpstr');
else
lpstr := vector.InsertBeforeChild(lpstr, 'element', 'vt:lpstr');
lpstr.SetValue(newSheetName);
break;
end
lpstr := lpstr.NextElement();
end
End;
Function NewSheet(sourceSheet, destSheet);overload; Function NewSheet(sourceSheet, destSheet);overload;
Begin Begin
@ -265,60 +338,12 @@ Type xlsxWorkBook = Class
sname := LowerCase(sourceSheet); sname := LowerCase(sourceSheet);
if not ifint(sheetIndexMap_[ sname ]) then return 'sourceSheet does not exists'; if not ifint(sheetIndexMap_[ sname ]) then return 'sourceSheet does not exists';
//添加文件xl/worksheets/sheetN.xml
sheetId := vselect maxof(['sheetId']) from sheetNames_ end;
sheetId := integer(sheetId) + 1;
fname := sheetPrefix_ $ inttostr(sheetsCount_ + 1) $ '.xml'; fname := sheetPrefix_ $ inttostr(sheetsCount_ + 1) $ '.xml';
zipfile_.Add(fname, class(TSXml).XmlHeader() + class(TSXml).GetTemplate('sheet1')); sheetId := addSheetN(fname);
rid := setWorkbookRels();
//设置 workbook.xml.rels insertWorkbookSheet(sourceSheet, destSheet, sheetId, rid, 'after');
rid := getWorkbookRelsRid(); insertDocPropsApp(sourceSheet, destSheet, 'after');
workbook_rels := GetXmlFileObj('xl/_rels/workbook.xml.rels'); setContentTypes(fname);
rels := workbook_rels.FirstChildElement('Relationships').InsertEndChild('element', 'Relationship');
rels.SetAttribute('Target', getTarget( sheetsCount_ + 1));
rels.SetAttribute('Type', class(TSXml).GetTemplate('RelationshipWorkSheet'));
rels.SetAttribute('Id', rid);
//workbook_rels.Print;
//设置 xl/workbook.xml
workbook := GetXmlFileObj('xl/workbook.xml');
node := workbook.FirstChildElement('workbook').FirstChildElement('sheets');
sheet_node := node.FirstChildElement('sheet');
while ifObj(sheet_node) do
begin
if sheet_node.GetAttribute('name') = sourceSheet then
begin
sheet_node := node.InsertAfterChild(sheet_node, 'element', 'sheet');
sheet_node.SetAttribute('name', destSheet);
sheet_node.SetAttribute('sheetId', sheetId);
sheet_node.SetAttribute('r:id', rid);
break;
end
sheet_node := sheet_node.NextElement();
end
//workbook.Print();
//设置docProps/app.xml
app := GetXmlFileObj(class(TSXml).GetFileName('docProps_app'));
//app.Print();
node := app.FirstChildElement('Properties').FirstChildElement('TitlesOfParts');
vector := node.FirstChildElement('vt:vector');
vector.SetAttribute('size', length(sheetNames_) + 1);
lpstr := vector.FirstChildElement('vt:lpstr');
while ifObj(lpstr) do
begin
if LowerCase(lpstr.GetText()) = LowerCase(sourceSheet) then
begin
lpstr := vector.InsertAfterChild(lpstr, 'element', 'vt:lpstr');
lpstr.SetValue(destSheet);
break;
end
lpstr := lpstr.NextElement();
end
//设置[Content_Types].xml
content_xml := GetXmlFileObj(class(TSXml).GetFileName('Content_Types'));
class(TSXml).AddOverrideContentType(content_xml, '/' + fname, class(TSXml).GetTemplate('sheetContentType'));
ind := sheetIndexMap_[sname]; ind := sheetIndexMap_[sname];
for i:=sheetsCount_ downto ind+2 do for i:=sheetsCount_ downto ind+2 do
@ -345,66 +370,12 @@ Type xlsxWorkBook = Class
sname := LowerCase(sourceSheet); sname := LowerCase(sourceSheet);
if not ifint(sheetIndexMap_[ sname ]) then return 'sourceSheet does not exists'; if not ifint(sheetIndexMap_[ sname ]) then return 'sourceSheet does not exists';
//添加文件xl/worksheets/sheetN.xml
sheetId := vselect maxof(['sheetId']) from sheetNames_ end;
sheetId := integer(sheetId) + 1;
fname := sheetPrefix_ $ inttostr(sheetsCount_ + 1) $ '.xml'; fname := sheetPrefix_ $ inttostr(sheetsCount_ + 1) $ '.xml';
zipfile_.Add(fname, class(TSXml).XmlHeader() + class(TSXml).GetTemplate('sheet1')); sheetId := addSheetN(fname);
rid := setWorkbookRels();
//设置 workbook.xml.rels insertWorkbookSheet(sourceSheet, destSheet, sheetId, rid, 'before');
rid := getWorkbookRelsRid(); insertDocPropsApp(sourceSheet, destSheet, 'before');
workbook_rels := GetXmlFileObj('xl/_rels/workbook.xml.rels'); setContentTypes(fname);
rels := workbook_rels.FirstChildElement('Relationships').InsertEndChild('element', 'Relationship');
rels.SetAttribute('Target', getTarget( sheetsCount_ + 1));
rels.SetAttribute('Type', class(TSXml).GetTemplate('RelationshipWorkSheet'));
rels.SetAttribute('Id', rid);
//workbook_rels.Print;
//设置 xl/workbook.xml
workbook := GetXmlFileObj('xl/workbook.xml');
node := workbook.FirstChildElement('workbook').FirstChildElement('sheets');
sheet_node := node.FirstChildElement('sheet');
prev_node := nil;
while ifObj(sheet_node) do
begin
if LowerCase(sheet_node.GetAttribute('name')) = LowerCase(sourceSheet) then
begin
if ifnil(prev_node) then sheet_node := node.InsertFirstChild('element', 'sheet');
else sheet_node := node.InsertAfterChild(prev_node, 'element', 'sheet');
sheet_node.SetAttribute('name', destSheet);
sheet_node.SetAttribute('sheetId', sheetId);
sheet_node.SetAttribute('r:id', rid);
break;
end
prev_node := sheet_node;
sheet_node := sheet_node.NextElement();
end
//workbook.Print();
//设置docProps/app.xml
app := GetXmlFileObj(class(TSXml).GetFileName('docProps_app'));
//app.Print();
node := app.FirstChildElement('Properties').FirstChildElement('TitlesOfParts');
vector := node.FirstChildElement('vt:vector');
vector.SetAttribute('size', length(sheetNames_) + 1);
lpstr := vector.FirstChildElement('vt:lpstr');
pstr := nil;
while ifObj(lpstr) do
begin
if LowerCase(lpstr.GetText()) = LowerCase(sourceSheet) then
begin
if ifnil(pstr) then lpstr := vector.InsertFirstChild('element', 'vt:lpstr');
else lpstr := vector.InsertAfterChild(pstr, 'element', 'vt:lpstr');
lpstr.SetValue(destSheet);
break;
end
pstr := lpstr;
lpstr := lpstr.NextElement();
end
//设置[Content_Types].xml
content_xml := GetXmlFileObj(class(TSXml).GetFileName('Content_Types'));
class(TSXml).AddOverrideContentType(content_xml, '/' + fname, class(TSXml).GetTemplate('sheetContentType'));
ind := sheetIndexMap_[sname]; ind := sheetIndexMap_[sname];
for i:=sheetsCount_ downto ind+1 do for i:=sheetsCount_ downto ind+1 do

View File

@ -1,5 +1,14 @@
# 更新日志 # 更新日志
## 2023-2-5
### V1.6.0
#### excel
1. 兼容Excel2016通过`NewSheet/InsertSheet`创建工作表不再提示修复错误
2. 修复带有表头的二维数组通过`InsertTable`写入数据只写入表头未写入数据问题
## 2023-1-31 ## 2023-1-31
### V1.5.9 ### V1.5.9