unit ImportExcel; interface uses DataBase, SMCells, SMXLS, Classes, ScKindsOfTrees, Variants; type TExcelImportor = class private FMSExcel : TMSExcel; FBillsData: TDMDataBase; FExcelTree: TScExcelItemTree; FCaptions : TStrings; FSpecialItems: TStrings; // 图标排除项 procedure InitSpecialItems(ASpecialItems: TStrings); function IsSpecialItem(const AString: string): Boolean; procedure ExtractSheetCaption; function SelectExcelSheet: Boolean; { 导入Sheets } procedure ImportSheets; function GetStartRow(aSheet: TSpreadSheet): Integer; function GetEndRow(aSheet: TSpreadSheet): Integer; procedure ImportSheet(aSheet: TSpreadSheet); // 结算格式 function IsBalanceFormat(ASheet: TSpreadSheet): Boolean; // 判断是否是招预01-1格式的Excel function Is01_1Excel(ASheet: TSpreadSheet): Boolean; // Add By GiLi procedure ImportBalanceSheet(ASheet: TSpreadSheet); procedure Import01_1Excel(ASheet: TSpreadSheet); // Add By GiLi { 初始化数据 } procedure InitExcelTree; { 提交数据到DB } procedure CommitData; public constructor Create(aBillsData: TDMDataBase; const aXlsFileName: string); destructor Destroy; override; { 导入清单文件 } procedure ImportExcel; { 导入工程量清单单价 } procedure ImportQtyItems; end; implementation uses ExportExFrm, ConstMethodUnit, SysUtils, ScProgressFrm, StrUtils; // 删除字符串中所以指定的字符 function DeleteCharFormString(var AString: string; const AChar: Char): string; var iPos: Integer; sStr: string; begin sStr := AString; iPos := Pos(AChar, sStr); while iPos <> 0 do begin Delete(sStr, iPos, 1); iPos := Pos(AChar, sStr); end; AString := sStr; Result := sStr; end; {去掉换行符} procedure DeleteRowBack(var str: string); var I: Integer; begin for I := Length(str) downto 1 do begin if (str[I] = #10) or (str[I] = #13) then Delete(str, I, 1); end; end; { TExcelImportor } procedure TExcelImportor.CommitData; begin FExcelTree.RefreshDataBase; end; constructor TExcelImportor.Create(aBillsData: TDMDataBase; const aXlsFileName: string); begin FBillsData := aBillsData; FMSExcel := TMSExcel.Create(nil); FMSExcel.LoadFromFile(aXlsFileName); FExcelTree := TScExcelItemTree.Create(FBillsData); FCaptions := TStringList.Create; FSpecialItems := TStringList.Create; InitSpecialItems(FSpecialItems); end; destructor TExcelImportor.Destroy; begin FMSExcel.Free; FExcelTree.Free; FCaptions.Free; inherited; end; procedure TExcelImportor.ExtractSheetCaption; var I: Integer; sCaption: string; begin for I := 0 to FMSExcel.Sheets.Count - 1 do begin sCaption := FMSExcel.Sheets.Spreadsheet(I).Caption; FCaptions.AddObject(sCaption, Pointer(I)); end; end; function TExcelImportor.GetEndRow(aSheet: TSpreadSheet): Integer; begin Result := aSheet.Cells.UsedRowCount - 1; if Pos('备注', VarToStr(aSheet.Cells.GetValue(0, Result))) <> 0 then Result := Result - 1; end; function TExcelImportor.GetStartRow(aSheet: TSpreadSheet): Integer; var I: Integer; begin Result := -1; for I := 0 to aSheet.Cells.UsedRowCount - 1 do begin if (Pos('-', VarToStr(aSheet.Cells.GetValue(0, I))) <> 0) and (Pos('附件', VarToStr(aSheet.Cells.GetValue(0, I))) = 0) then begin Result := I; Break; end; if SameText(VarToStr(aSheet.Cells.GetValue(0, I)), '预算项目节') or SameText(VarToStr(aSheet.Cells.GetValue(0, I)), '项目节编号') then begin Result := I + 1; Break; end; end; end; procedure TExcelImportor.Import01_1Excel(ASheet: TSpreadSheet); var iRow, I: Integer; iSerialNo: Integer; strXMJCode: string; strBillsCode: string; strName: string; sgsCodes: TStrings; bCodeEmpty: Boolean; PartCode: string; function SetCurPartCode: string; var ACurName: string; begin ACurName := Trim(VarToStrDef(aSheet.Cells.GetValue(5, iRow), '')); DeleteRowBack(ACurName); DeleteCharFormString(ACurName, #32); if Pos('第一部分', ACurName) > 0 then PartCode := '1-' else if Pos('第二部分', ACurName) > 0 then PartCode := '2-' else if Pos('第三部分', ACurName) > 0 then PartCode := '3-' else if Pos('第一、二、三部分', ACurName) > 0 then PartCode := '' else PartCode := PartCode; end; function GetXMJCode: string; const c_widestring: WideString = '一二三四五六七八九十'; var ACurCode: string; ACurBuFenName: string; var I: Integer; begin Result := ''; for I := 0 to sgsCodes.Count - 1 do begin ACurCode := sgsCodes[I]; // 如果是汉字的数字 一二... if Length(ACurCode) > 1 then begin // 有两个数字的汉字 if Length(ACurCode) > 2 then begin ACurCode := IntToStr(10 * Pos(LeftStr(ACurCode, 1), c_widestring) + Pos(RightStr(ACurCode, 1), c_widestring)); end // 只有一个数字的汉字 else begin ACurCode := IntToStr(Pos(ACurCode, c_widestring)); end; end; if Result = '' then Result := ACurCode else Result := Result + '-' + ACurCode; end; SetCurPartCode; if Result <> '' then Result := PartCode + Result; end; function GetBillsCode: string; begin Result := Trim(VarToStrDef(aSheet.Cells.GetValue(4, iRow), '')); end; function GetName: string; begin Result := Trim(VarToStrDef(aSheet.Cells.GetValue(5, iRow), '')); DeleteRowBack(Result); SetCurPartCode; end; function IsDrawingQuantity: Boolean; begin Result := (strXMJCode = '') and (strBillsCode = '') and (not IsSpecialItem(Trim(strName))) and (strName <> '暂列金额(不含计日工总额)') and (strName <> '保险费') and (strName <> '*请在此输入费用项目'); end; procedure AddDrawingQuantity; var DrawingItem: TDrawingQuantityItem; begin if strName <> '' then begin DrawingItem := FExcelTree.AddDrawQuantity; DrawingItem.SerinalNo := iSerialNo; DrawingItem.Name := strName; DrawingItem.Units := VarToStrDef(ASheet.Cells.GetValue(6, iRow), ''); Inc(iSerialNo); end; end; function GetFloatValue(ACol: Integer): Double; var V: Variant; sValue: string; begin Result := 0; V := ASheet.Cells.GetValue(ACol, iRow); if not VarIsNull(V) then begin sValue := Trim(VarToStrDef(V, '')); DeleteRowBack(sValue); DeleteCharFormString(sValue, ','); Result := StrToFloatDef(Trim(sValue), 0); end; end; procedure GetQuantityXY(const vQuantity: Variant; var X,Y: Double); var iDivPos, iTemp: Integer; // 除号的位置 AStrQuantity, strTemp: string; begin X := 0; Y := 0; if VarIsNull(vQuantity) then Exit; AStrQuantity := VarToStrDef(vQuantity, ''); iDivPos := Pos('/', AStrQuantity); if iDivPos = 0 then begin Val(AStrQuantity, X, iDivPos); Y := 0; end else begin strTemp := AStrQuantity; iTemp := iDivPos; Val(LeftStr(AStrQuantity, iDivPos - 1), X, iDivPos); strTemp := Copy(strTemp, iTemp+1, Length(strTemp)); Val(strTemp, Y, iDivPos); end; end; procedure AddXMJBills; var xlsItem: TScExcelItem; CurQuantity: Variant; Quantity1, Quantity2: Double; begin xlsItem := FExcelTree.AddNodeByCode(strXMJCode, strBillsCode); if Assigned(xlsItem) then begin xlsItem.Name := strName; xlsItem.Units := VarToStrDef(ASheet.Cells.GetValue(6, iRow), ''); // 数量 CurQuantity := ASheet.Cells.GetValue(7, iRow); GetQuantityXY(CurQuantity, Quantity1, Quantity2); // 清单数量 //xlsItem.Quantity := GetFloatValue(x); if strBillsCode <> '' then begin xlsItem.Quantity := Quantity1; // 清单单价 xlsItem.Price := GetFloatValue(9); end else // 设计数量 begin // 设计数量1 if Quantity1 <> 0 then xlsItem.Quantity1 := Quantity1; // 设计数量2 if Quantity2 <> 0 then xlsItem.Quantity2 := Quantity2; end; // 金额 xlsItem.TotalPrice := GetFloatValue(8); xlsItem.MemoString := VarToStrDef(ASheet.Cells.GetValue(11, iRow), ''); end; iSerialNo := 1; end; procedure InitXMJCodeAndBillsCodeAndName; begin strBillsCode := GetBillsCode; if strBillsCode <> '' then begin DeleteRowBack(strBillsCode); DeleteCharFormString(strBillsCode, #32); end; strName := GetName; if (strBillsCode = '') and (not bCodeEmpty) then strXMJCode := GetXMJCode else strXMJCode := ''; end; procedure MapXMJCode(AColumn: Integer); var strCode: string; begin strCode := Trim(VarToStrDef(aSheet.Cells.GetValue(AColumn, iRow), '')); if strCode <> '' then begin while sgsCodes.Count > AColumn do sgsCodes.Delete(sgsCodes.Count - 1); sgsCodes.Add(strCode); bCodeEmpty := False; end; end; procedure MapXMJCodeIntoStrings; begin MapXMJCode(0); MapXMJCode(1); MapXMJCode(2); MapXMJCode(3); end; procedure ImportRowXMJBillsAndDrawingQuantity; begin if IsDrawingQuantity then AddDrawingQuantity else AddXMJBills; end; procedure ResetCodeEmpty; begin bCodeEmpty := True; end; function GetCurRow(aI: Integer): Integer; var ACurName: string; begin ACurName := Trim(VarToStrDef(aSheet.Cells.GetValue(1 , aI), '')); if Pos('编制', ACurName) > 0 then Result := aI + 5 else Result := aI; end; begin sgsCodes := TStringList.Create; try // 01-1 表从第三行开始 I := 4; PartCode := ''; while I < ASheet.Cells.UsedRowCount do begin iRow := GetCurRow(I); if iRow <> I then I := iRow; ResetCodeEmpty; MapXMJCodeIntoStrings; InitXMJCodeAndBillsCodeAndName; ImportRowXMJBillsAndDrawingQuantity; Inc(I); end; finally sgsCodes.Free; end; end; procedure TExcelImportor.ImportBalanceSheet(ASheet: TSpreadSheet); var iRow: Integer; iSerialNo: Integer; strXMJCode: string; strBillsCode: string; strName: string; sgsCodes: TStrings; bCodeEmpty: Boolean; function GetXMJCode: string; var I: Integer; begin Result := ''; for I := 0 to sgsCodes.Count - 1 do begin if Result = '' then Result := sgsCodes[I] else Result := Result + '-' + sgsCodes[I]; end; if Result <> '' then Result := '1-' + Result; end; function GetBillsCode: string; begin Result := Trim(VarToStrDef(aSheet.Cells.GetValue(7, iRow), '')); end; function GetName: string; begin Result := Trim(VarToStrDef(aSheet.Cells.GetValue(8, iRow), '')); DeleteRowBack(Result); end; function IsDrawingQuantity: Boolean; begin Result := (strXMJCode = '') and (strBillsCode = ''); end; procedure AddDrawingQuantity; var DrawingItem: TDrawingQuantityItem; begin if strName <> '' then begin DrawingItem := FExcelTree.AddDrawQuantity; DrawingItem.SerinalNo := iSerialNo; DrawingItem.Name := strName; DrawingItem.Units := VarToStrDef(ASheet.Cells.GetValue(9, iRow), ''); Inc(iSerialNo); end; end; function GetFloatValue(ACol: Integer): Double; var V: Variant; begin Result := 0; V := ASheet.Cells.GetValue(ACol, iRow); if not VarIsNull(V) then Result := StrToFloatDef(Trim(V), 0); end; procedure AddXMJBills; var xlsItem: TScExcelItem; begin xlsItem := FExcelTree.AddNodeByCode(strXMJCode, strBillsCode); if Assigned(xlsItem) then begin xlsItem.Name := strName; xlsItem.Units := VarToStrDef(ASheet.Cells.GetValue(9, iRow), ''); // 清单数量 xlsItem.Quantity := GetFloatValue(10); // 设计数量1 xlsItem.Quantity1 := GetFloatValue(11); // 设计数量2 xlsItem.Quantity2 := GetFloatValue(12); // 单价 xlsItem.Price := GetFloatValue(13); // 金额 xlsItem.TotalPrice := GetFloatValue(14); end; iSerialNo := 1; end; procedure InitXMJCodeAndBillsCodeAndName; begin strBillsCode := GetBillsCode; strName := GetName; if (strBillsCode = '') and (not bCodeEmpty) then strXMJCode := GetXMJCode else strXMJCode := ''; end; procedure MapXMJCode(AColumn: Integer); var strCode: string; begin strCode := Trim(VarToStrDef(aSheet.Cells.GetValue(AColumn, iRow), '')); if strCode <> '' then begin while sgsCodes.Count > AColumn do sgsCodes.Delete(sgsCodes.Count - 1); sgsCodes.Add(strCode); bCodeEmpty := False; end; end; procedure MapXMJCodeIntoStrings; begin MapXMJCode(0); MapXMJCode(1); MapXMJCode(2); MapXMJCode(3); MapXMJCode(4); MapXMJCode(5); MapXMJCode(6); end; procedure ImportRowXMJBillsAndDrawingQuantity; begin if IsDrawingQuantity then AddDrawingQuantity else AddXMJBills; end; procedure ResetCodeEmpty; begin bCodeEmpty := True; end; begin sgsCodes := TStringList.Create; try for iRow := 1 to ASheet.Cells.UsedRowCount - 1 do begin ResetCodeEmpty; MapXMJCodeIntoStrings; InitXMJCodeAndBillsCodeAndName; ImportRowXMJBillsAndDrawingQuantity; end; finally sgsCodes.Free; end; end; procedure TExcelImportor.ImportExcel; begin ExtractSheetCaption; if not SelectExcelSheet then Exit; AddProgressForm(10,'正在检测Excel...'); IncProgressUI(10); InitExcelTree; AddProgressForm(10,'正在初始化Excel...'); IncProgressUI(10); ImportSheets; AddProgressForm(50,'正在导入Excel...'); IncProgressUI(50); CommitData; AddProgressForm(20,'正在生成数据...'); IncProgressUI(20); end; procedure TExcelImportor.ImportQtyItems; var iLoop, iRow: Integer; ssSheet: TSpreadSheet; strCode: string; bReading: Boolean; dUnitPrice: Double; begin FBillsData.BeginImport; // Added by GiLi 2012-4-18 15:11:11 添加浮动进度条 CreateProgressForm(100, '正在导入工程量清单单价>>>'); try for iLoop := 0 to FMSExcel.Sheets.Count - 1 do begin ssSheet := FMSExcel.Sheets.Spreadsheet(iLoop); iRow := 0; bReading := False; while iRow <= ssSheet.Cells.UsedRowCount - 1 do begin strCode := Trim(VarToStrDef(ssSheet.Cells.GetValue(0, iRow), '')); if not bReading then begin if SameText(strCode, '子目号') then bReading := True; Inc(iRow); Continue; end; if strCode = '' then begin bReading := False; Inc(iRow); Continue; end; if VarIsNull(ssSheet.Cells.GetValue(4, iRow)) then dUnitPrice := 0 else dUnitPrice := StrToFloatDef(Trim(ssSheet.Cells.GetValue(4, iRow)), 0); AddProgressForm(10, Format('正在导入第%d个Sheet...', [iLoop + 1])); FBillsData.AssignQtyItemUnitPrice(strCode, dUnitPrice); Inc(iRow); end; end; finally CloseFloatProgress; FBillsData.EndImport; end; end; procedure TExcelImportor.ImportSheet(aSheet: TSpreadSheet); var iBeginRow: Integer; iEndRow : Integer; iCurRow : Integer; iSerialNo: Integer; iCode : Integer; iErrCode : Integer; sCode : string; sB_Code : string; sName : string; xlsItem : TScExcelItem; xlsDQItem: TDrawingQuantityItem; begin iBeginRow := GetStartRow(aSheet); iEndRow := GetEndRow(aSheet); if (iBeginRow = -1) or (iBeginRow > iEndRow) then raise Exception.Create(Format('读取工作表[%s]的数据失败, 请检查该表是否有数据或格式是否正确!', [aSheet.Caption])); iSerialNo := 1; for iCurRow := iBeginRow to iEndRow do begin sCode := Trim(VarToStrDef(aSheet.Cells.GetValue(0, iCurRow), '')); sB_Code := Trim(VarToStrDef(aSheet.Cells.GetValue(1, iCurRow), '')); sName := Trim(VarToStrDef(aSheet.Cells.GetValue(2, iCurRow), '')); {新需求,只导入一二三部分。 chenshilong, 2013-08-15 [需求描述]导入三级清单后,一二三部分之后的工程量清单位置错误。 如:102-5交通管制经费跑到第二部分下了,有的跑到第一和第三部分下了。 如:第三部分之后的项目节导入为第三部分中最后一个节点的设计细目了。 解决方案为:导入时,读取到“第一、二、三部分 费用合计”这行时,则 停止导入后面的数据行。} if SameText(sName, '第一、二、三部分 费用合计') then Break; DeleteRowBack(sName); if (sCode = '') and (sB_Code = '') then begin if sName = '' then Continue; xlsDQItem := FExcelTree.AddDrawQuantity; xlsDQItem.SerinalNo := iSerialNo; xlsDQItem.Name := sName; xlsDQItem.Units := VarToStrDef(aSheet.Cells.GetValue(3, iCurRow), ''); if not VarIsNull(aSheet.Cells.GetValue(5, iCurRow)) then xlsDQItem.DesignQuantity1 := StrToFloatDef(Trim(aSheet.Cells.GetValue(5, iCurRow)), 0); if not VarIsNull(aSheet.Cells.GetValue(6, iCurRow)) then xlsDQItem.DesignQuantity2 := StrToFloatDef(Trim(aSheet.Cells.GetValue(6, iCurRow)), 0); xlsDQItem.MemoContext := VarToStrDef(aSheet.Cells.GetValue(9, iCurRow), ''); Inc(iSerialNo); end else begin Val(sCode, iCode, iErrCode); {当大于第三部分时不再导入} if iCode > 3 then Break; xlsItem := FExcelTree.AddNodeByCode(sCode, sB_Code); if not Assigned(xlsItem) then Continue; iSerialNo := 1; xlsItem.Name := sName; xlsItem.Units := VarToStrDef(aSheet.Cells.GetValue(3, iCurRow), ''); if not VarIsNull(aSheet.Cells.GetValue(4, iCurRow)) then xlsItem.Quantity := StrToFloatDef(Trim(aSheet.Cells.GetValue(4, iCurRow)), 0); if not VarIsNull(aSheet.Cells.GetValue(5, iCurRow)) then xlsItem.Quantity1 := StrToFloatDef(Trim(aSheet.Cells.GetValue(5, iCurRow)), 0); if not VarIsNull(aSheet.Cells.GetValue(6, iCurRow)) then xlsItem.Quantity2 := StrToFloatDef(Trim(aSheet.Cells.GetValue(6, iCurRow)), 0); if not VarIsNull(aSheet.Cells.GetValue(7, iCurRow)) then xlsItem.Price := StrToFloatDef(Trim(aSheet.Cells.GetValue(7, iCurRow)), 0); if not VarIsNull(aSheet.Cells.GetValue(8, iCurRow)) then xlsItem.TotalPrice := StrToFloatDef(Trim(aSheet.Cells.GetValue(8, iCurRow)), 0); xlsItem.MemoString := VarToStrDef(aSheet.Cells.GetValue(9, iCurRow), ''); end; end; end; procedure TExcelImportor.ImportSheets; var I: Integer; iSheet: Integer; ssSheet: TSpreadSheet; begin for I := 0 to FCaptions.Count - 1 do begin iSheet := Integer(FCaptions.Objects[I]); ssSheet := FMSExcel.Sheets.Spreadsheet(iSheet); if IsBalanceFormat(ssSheet) then ImportBalanceSheet(ssSheet) else if Is01_1Excel(ssSheet) then // Added by GiLi 可以导入01-1表 Import01_1Excel(ssSheet) else ImportSheet(ssSheet); end; end; procedure TExcelImportor.InitExcelTree; begin FExcelTree.ViewBillTreeParts; FExcelTree.AddFirstNode(FBillsData.BillsTree.FirstNode.ID); FExcelTree.MaxNodeID := FBillsData.GetMaxBillsID; FExcelTree.MaxDrawQID := FBillsData.GetMaxDrawingQuangtiyID; end; procedure TExcelImportor.InitSpecialItems(ASpecialItems: TStrings); begin with ASpecialItems do begin Add('第一部分建筑安装工程费'); Add('第二部分设备及工具、器具购置费'); Add('第三部分工程建设其他费用'); Add('第一、二、三部分费用合计'); Add('预备费'); Add('预留费用'); Add('新增加费用项目(不作预备费基数)'); Add('其中:回收金额'); Add('预算总金额'); Add('概算总金额'); Add('公路基本造价'); Add('1.价差预备费'); Add('1.价差预留费'); Add('2.基本预备费'); Add('2.暂列金额(不含计日工总额)'); Add('建设期贷款利息'); Add('公路功能以外的工程费用(如有)'); Add('项目总造价'); Add('其他费用项目'); end; end; function TExcelImportor.Is01_1Excel(ASheet: TSpreadSheet): Boolean; begin Result := (ASheet.Cells.UsedRowCount > 0) and (ASheet.Cells.UsedColCount > 5); if Result then Result := SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(0, 3), '')), '项') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(1, 3), '')), '目') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(2, 3), '')), '节') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(3, 3), '')), '细目') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(4, 3), '')), '清单子目号'); end; function TExcelImportor.IsBalanceFormat(ASheet: TSpreadSheet): Boolean; begin Result := (ASheet.Cells.UsedRowCount > 0) and (ASheet.Cells.UsedColCount > 7); if Result then Result := SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(0, 0), '')), '项') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(1, 0), '')), '目') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(2, 0), '')), '节') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(3, 0), '')), '分项1') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(4, 0), '')), '分项2') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(5, 0), '')), '分项3') and SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(6, 0), '')), '分项4'); end; function TExcelImportor.IsSpecialItem(const AString: string): Boolean; var I: Integer; begin if not Assigned(FSpecialItems) then begin Result := False; Exit; end; if FSpecialItems.Count = 0 then begin Result := False; Exit; end; for I:=0 to FSpecialItems.Count - 1 do begin if SameText(AString, FSpecialItems[I]) then begin Result := True; Exit; end; end; Result := False; end; function TExcelImportor.SelectExcelSheet: Boolean; begin Result := ExportExFrm.SelectExcelSheet(FCaptions); if Result and (FCaptions.Count = 0) then begin Result := False; raise Exception.Create('选择工作表个数为0, 没有执行导入Excel操作.'); end; end; end.