ImportExcel.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871
  1. unit ImportExcel;
  2. interface
  3. uses
  4. DataBase,
  5. SMCells,
  6. SMXLS,
  7. Classes,
  8. ScKindsOfTrees,
  9. Variants;
  10. type
  11. TExcelImportor = class
  12. private
  13. FMSExcel : TMSExcel;
  14. FBillsData: TDMDataBase;
  15. FExcelTree: TScExcelItemTree;
  16. FCaptions : TStrings;
  17. FSpecialItems: TStrings; // 图标排除项
  18. procedure InitSpecialItems(ASpecialItems: TStrings);
  19. function IsSpecialItem(const AString: string): Boolean;
  20. procedure ExtractSheetCaption;
  21. function SelectExcelSheet: Boolean;
  22. { 导入Sheets }
  23. procedure ImportSheets;
  24. function GetStartRow(aSheet: TSpreadSheet): Integer;
  25. function GetEndRow(aSheet: TSpreadSheet): Integer;
  26. procedure ImportSheet(aSheet: TSpreadSheet);
  27. // 结算格式
  28. function IsBalanceFormat(ASheet: TSpreadSheet): Boolean;
  29. // 判断是否是招预01-1格式的Excel
  30. function Is01_1Excel(ASheet: TSpreadSheet): Boolean; // Add By GiLi
  31. procedure ImportBalanceSheet(ASheet: TSpreadSheet);
  32. procedure Import01_1Excel(ASheet: TSpreadSheet); // Add By GiLi
  33. { 初始化数据 }
  34. procedure InitExcelTree;
  35. { 提交数据到DB }
  36. procedure CommitData;
  37. public
  38. constructor Create(aBillsData: TDMDataBase; const aXlsFileName: string);
  39. destructor Destroy; override;
  40. { 导入清单文件 }
  41. procedure ImportExcel;
  42. { 导入工程量清单单价 }
  43. procedure ImportQtyItems;
  44. end;
  45. implementation
  46. uses
  47. ExportExFrm,
  48. ConstMethodUnit,
  49. SysUtils,
  50. ScProgressFrm,
  51. StrUtils;
  52. // 删除字符串中所以指定的字符
  53. function DeleteCharFormString(var AString: string; const AChar: Char): string;
  54. var
  55. iPos: Integer;
  56. sStr: string;
  57. begin
  58. sStr := AString;
  59. iPos := Pos(AChar, sStr);
  60. while iPos <> 0 do
  61. begin
  62. Delete(sStr, iPos, 1);
  63. iPos := Pos(AChar, sStr);
  64. end;
  65. AString := sStr;
  66. Result := sStr;
  67. end;
  68. {去掉换行符}
  69. procedure DeleteRowBack(var str: string);
  70. var
  71. I: Integer;
  72. begin
  73. for I := Length(str) downto 1 do
  74. begin
  75. if (str[I] = #10) or (str[I] = #13) then
  76. Delete(str, I, 1);
  77. end;
  78. end;
  79. { TExcelImportor }
  80. procedure TExcelImportor.CommitData;
  81. begin
  82. FExcelTree.RefreshDataBase;
  83. end;
  84. constructor TExcelImportor.Create(aBillsData: TDMDataBase;
  85. const aXlsFileName: string);
  86. begin
  87. FBillsData := aBillsData;
  88. FMSExcel := TMSExcel.Create(nil);
  89. FMSExcel.LoadFromFile(aXlsFileName);
  90. FExcelTree := TScExcelItemTree.Create(FBillsData);
  91. FCaptions := TStringList.Create;
  92. FSpecialItems := TStringList.Create;
  93. InitSpecialItems(FSpecialItems);
  94. end;
  95. destructor TExcelImportor.Destroy;
  96. begin
  97. FMSExcel.Free;
  98. FExcelTree.Free;
  99. FCaptions.Free;
  100. inherited;
  101. end;
  102. procedure TExcelImportor.ExtractSheetCaption;
  103. var
  104. I: Integer;
  105. sCaption: string;
  106. begin
  107. for I := 0 to FMSExcel.Sheets.Count - 1 do
  108. begin
  109. sCaption := FMSExcel.Sheets.Spreadsheet(I).Caption;
  110. FCaptions.AddObject(sCaption, Pointer(I));
  111. end;
  112. end;
  113. function TExcelImportor.GetEndRow(aSheet: TSpreadSheet): Integer;
  114. begin
  115. Result := aSheet.Cells.UsedRowCount - 1;
  116. if Pos('备注', VarToStr(aSheet.Cells.GetValue(0, Result))) <> 0 then
  117. Result := Result - 1;
  118. end;
  119. function TExcelImportor.GetStartRow(aSheet: TSpreadSheet): Integer;
  120. var
  121. I: Integer;
  122. begin
  123. Result := -1;
  124. for I := 0 to aSheet.Cells.UsedRowCount - 1 do
  125. begin
  126. if (Pos('-', VarToStr(aSheet.Cells.GetValue(0, I))) <> 0)
  127. and
  128. (Pos('附件', VarToStr(aSheet.Cells.GetValue(0, I))) = 0)
  129. then
  130. begin
  131. Result := I;
  132. Break;
  133. end;
  134. if SameText(VarToStr(aSheet.Cells.GetValue(0, I)), '预算项目节')
  135. or
  136. SameText(VarToStr(aSheet.Cells.GetValue(0, I)), '项目节编号')
  137. then
  138. begin
  139. Result := I + 1;
  140. Break;
  141. end;
  142. end;
  143. end;
  144. procedure TExcelImportor.Import01_1Excel(ASheet: TSpreadSheet);
  145. var
  146. iRow, I: Integer;
  147. iSerialNo: Integer;
  148. strXMJCode: string;
  149. strBillsCode: string;
  150. strName: string;
  151. sgsCodes: TStrings;
  152. bCodeEmpty: Boolean;
  153. PartCode: string;
  154. function SetCurPartCode: string;
  155. var
  156. ACurName: string;
  157. begin
  158. ACurName := Trim(VarToStrDef(aSheet.Cells.GetValue(5, iRow), ''));
  159. DeleteRowBack(ACurName);
  160. DeleteCharFormString(ACurName, #32);
  161. if Pos('第一部分', ACurName) > 0 then
  162. PartCode := '1-'
  163. else
  164. if Pos('第二部分', ACurName) > 0 then
  165. PartCode := '2-'
  166. else
  167. if Pos('第三部分', ACurName) > 0 then
  168. PartCode := '3-'
  169. else
  170. if Pos('第一、二、三部分', ACurName) > 0 then
  171. PartCode := ''
  172. else
  173. PartCode := PartCode;
  174. end;
  175. function GetXMJCode: string;
  176. const
  177. c_widestring: WideString = '一二三四五六七八九十';
  178. var
  179. ACurCode: string;
  180. ACurBuFenName: string;
  181. var
  182. I: Integer;
  183. begin
  184. Result := '';
  185. for I := 0 to sgsCodes.Count - 1 do
  186. begin
  187. ACurCode := sgsCodes[I];
  188. // 如果是汉字的数字 一二...
  189. if Length(ACurCode) > 1 then
  190. begin
  191. // 有两个数字的汉字
  192. if Length(ACurCode) > 2 then
  193. begin
  194. ACurCode := IntToStr(10 * Pos(LeftStr(ACurCode, 1), c_widestring)
  195. + Pos(RightStr(ACurCode, 1), c_widestring));
  196. end
  197. // 只有一个数字的汉字
  198. else
  199. begin
  200. ACurCode := IntToStr(Pos(ACurCode, c_widestring));
  201. end;
  202. end;
  203. if Result = '' then
  204. Result := ACurCode
  205. else
  206. Result := Result + '-' + ACurCode;
  207. end;
  208. SetCurPartCode;
  209. if Result <> '' then
  210. Result := PartCode + Result;
  211. end;
  212. function GetBillsCode: string;
  213. begin
  214. Result := Trim(VarToStrDef(aSheet.Cells.GetValue(4, iRow), ''));
  215. end;
  216. function GetName: string;
  217. begin
  218. Result := Trim(VarToStrDef(aSheet.Cells.GetValue(5, iRow), ''));
  219. DeleteRowBack(Result);
  220. SetCurPartCode;
  221. end;
  222. function IsDrawingQuantity: Boolean;
  223. begin
  224. Result := (strXMJCode = '') and (strBillsCode = '') and (not IsSpecialItem(Trim(strName)))
  225. and (strName <> '暂列金额(不含计日工总额)') and (strName <> '保险费')
  226. and (strName <> '*请在此输入费用项目');
  227. end;
  228. procedure AddDrawingQuantity;
  229. var
  230. DrawingItem: TDrawingQuantityItem;
  231. begin
  232. if strName <> '' then
  233. begin
  234. DrawingItem := FExcelTree.AddDrawQuantity;
  235. DrawingItem.SerinalNo := iSerialNo;
  236. DrawingItem.Name := strName;
  237. DrawingItem.Units := VarToStrDef(ASheet.Cells.GetValue(6, iRow), '');
  238. Inc(iSerialNo);
  239. end;
  240. end;
  241. function GetFloatValue(ACol: Integer): Double;
  242. var
  243. V: Variant;
  244. sValue: string;
  245. begin
  246. Result := 0;
  247. V := ASheet.Cells.GetValue(ACol, iRow);
  248. if not VarIsNull(V) then
  249. begin
  250. sValue := Trim(VarToStrDef(V, ''));
  251. DeleteRowBack(sValue);
  252. DeleteCharFormString(sValue, ',');
  253. Result := StrToFloatDef(Trim(sValue), 0);
  254. end;
  255. end;
  256. procedure GetQuantityXY(const vQuantity: Variant; var X,Y: Double);
  257. var
  258. iDivPos, iTemp: Integer; // 除号的位置
  259. AStrQuantity, strTemp: string;
  260. begin
  261. X := 0;
  262. Y := 0;
  263. if VarIsNull(vQuantity) then
  264. Exit;
  265. AStrQuantity := VarToStrDef(vQuantity, '');
  266. iDivPos := Pos('/', AStrQuantity);
  267. if iDivPos = 0 then
  268. begin
  269. Val(AStrQuantity, X, iDivPos);
  270. Y := 0;
  271. end
  272. else
  273. begin
  274. strTemp := AStrQuantity;
  275. iTemp := iDivPos;
  276. Val(LeftStr(AStrQuantity, iDivPos - 1), X, iDivPos);
  277. strTemp := Copy(strTemp, iTemp+1, Length(strTemp));
  278. Val(strTemp, Y, iDivPos);
  279. end;
  280. end;
  281. procedure AddXMJBills;
  282. var
  283. xlsItem: TScExcelItem;
  284. CurQuantity: Variant;
  285. Quantity1, Quantity2: Double;
  286. begin
  287. xlsItem := FExcelTree.AddNodeByCode(strXMJCode, strBillsCode);
  288. if Assigned(xlsItem) then
  289. begin
  290. xlsItem.Name := strName;
  291. xlsItem.Units := VarToStrDef(ASheet.Cells.GetValue(6, iRow), '');
  292. // 数量
  293. CurQuantity := ASheet.Cells.GetValue(7, iRow);
  294. GetQuantityXY(CurQuantity, Quantity1, Quantity2);
  295. // 清单数量
  296. //xlsItem.Quantity := GetFloatValue(x);
  297. if strBillsCode <> '' then
  298. begin
  299. xlsItem.Quantity := Quantity1;
  300. // 清单单价
  301. xlsItem.Price := GetFloatValue(9);
  302. end
  303. else
  304. // 设计数量
  305. begin
  306. // 设计数量1
  307. if Quantity1 <> 0 then
  308. xlsItem.Quantity1 := Quantity1;
  309. // 设计数量2
  310. if Quantity2 <> 0 then
  311. xlsItem.Quantity2 := Quantity2;
  312. end;
  313. // 金额
  314. xlsItem.TotalPrice := GetFloatValue(8);
  315. xlsItem.MemoString := VarToStrDef(ASheet.Cells.GetValue(11, iRow), '');
  316. end;
  317. iSerialNo := 1;
  318. end;
  319. procedure InitXMJCodeAndBillsCodeAndName;
  320. begin
  321. strBillsCode := GetBillsCode;
  322. if strBillsCode <> '' then
  323. begin
  324. DeleteRowBack(strBillsCode);
  325. DeleteCharFormString(strBillsCode, #32);
  326. end;
  327. strName := GetName;
  328. if (strBillsCode = '') and (not bCodeEmpty) then
  329. strXMJCode := GetXMJCode
  330. else
  331. strXMJCode := '';
  332. end;
  333. procedure MapXMJCode(AColumn: Integer);
  334. var
  335. strCode: string;
  336. begin
  337. strCode := Trim(VarToStrDef(aSheet.Cells.GetValue(AColumn, iRow), ''));
  338. if strCode <> '' then
  339. begin
  340. while sgsCodes.Count > AColumn do
  341. sgsCodes.Delete(sgsCodes.Count - 1);
  342. sgsCodes.Add(strCode);
  343. bCodeEmpty := False;
  344. end;
  345. end;
  346. procedure MapXMJCodeIntoStrings;
  347. begin
  348. MapXMJCode(0);
  349. MapXMJCode(1);
  350. MapXMJCode(2);
  351. MapXMJCode(3);
  352. end;
  353. procedure ImportRowXMJBillsAndDrawingQuantity;
  354. begin
  355. if IsDrawingQuantity then
  356. AddDrawingQuantity
  357. else
  358. AddXMJBills;
  359. end;
  360. procedure ResetCodeEmpty;
  361. begin
  362. bCodeEmpty := True;
  363. end;
  364. function GetCurRow(aI: Integer): Integer;
  365. var
  366. ACurName: string;
  367. begin
  368. ACurName := Trim(VarToStrDef(aSheet.Cells.GetValue(1 , aI), ''));
  369. if Pos('编制', ACurName) > 0 then
  370. Result := aI + 5
  371. else
  372. Result := aI;
  373. end;
  374. begin
  375. sgsCodes := TStringList.Create;
  376. try
  377. // 01-1 表从第三行开始
  378. I := 4;
  379. PartCode := '';
  380. while I < ASheet.Cells.UsedRowCount do
  381. begin
  382. iRow := GetCurRow(I);
  383. if iRow <> I then
  384. I := iRow;
  385. ResetCodeEmpty;
  386. MapXMJCodeIntoStrings;
  387. InitXMJCodeAndBillsCodeAndName;
  388. ImportRowXMJBillsAndDrawingQuantity;
  389. Inc(I);
  390. end;
  391. finally
  392. sgsCodes.Free;
  393. end;
  394. end;
  395. procedure TExcelImportor.ImportBalanceSheet(ASheet: TSpreadSheet);
  396. var
  397. iRow: Integer;
  398. iSerialNo: Integer;
  399. strXMJCode: string;
  400. strBillsCode: string;
  401. strName: string;
  402. sgsCodes: TStrings;
  403. bCodeEmpty: Boolean;
  404. function GetXMJCode: string;
  405. var
  406. I: Integer;
  407. begin
  408. Result := '';
  409. for I := 0 to sgsCodes.Count - 1 do
  410. begin
  411. if Result = '' then
  412. Result := sgsCodes[I]
  413. else
  414. Result := Result + '-' + sgsCodes[I];
  415. end;
  416. if Result <> '' then
  417. Result := '1-' + Result;
  418. end;
  419. function GetBillsCode: string;
  420. begin
  421. Result := Trim(VarToStrDef(aSheet.Cells.GetValue(7, iRow), ''));
  422. end;
  423. function GetName: string;
  424. begin
  425. Result := Trim(VarToStrDef(aSheet.Cells.GetValue(8, iRow), ''));
  426. DeleteRowBack(Result);
  427. end;
  428. function IsDrawingQuantity: Boolean;
  429. begin
  430. Result := (strXMJCode = '') and (strBillsCode = '');
  431. end;
  432. procedure AddDrawingQuantity;
  433. var
  434. DrawingItem: TDrawingQuantityItem;
  435. begin
  436. if strName <> '' then
  437. begin
  438. DrawingItem := FExcelTree.AddDrawQuantity;
  439. DrawingItem.SerinalNo := iSerialNo;
  440. DrawingItem.Name := strName;
  441. DrawingItem.Units := VarToStrDef(ASheet.Cells.GetValue(9, iRow), '');
  442. Inc(iSerialNo);
  443. end;
  444. end;
  445. function GetFloatValue(ACol: Integer): Double;
  446. var
  447. V: Variant;
  448. begin
  449. Result := 0;
  450. V := ASheet.Cells.GetValue(ACol, iRow);
  451. if not VarIsNull(V) then
  452. Result := StrToFloatDef(Trim(V), 0);
  453. end;
  454. procedure AddXMJBills;
  455. var
  456. xlsItem: TScExcelItem;
  457. begin
  458. xlsItem := FExcelTree.AddNodeByCode(strXMJCode, strBillsCode);
  459. if Assigned(xlsItem) then
  460. begin
  461. xlsItem.Name := strName;
  462. xlsItem.Units := VarToStrDef(ASheet.Cells.GetValue(9, iRow), '');
  463. // 清单数量
  464. xlsItem.Quantity := GetFloatValue(10);
  465. // 设计数量1
  466. xlsItem.Quantity1 := GetFloatValue(11);
  467. // 设计数量2
  468. xlsItem.Quantity2 := GetFloatValue(12);
  469. // 单价
  470. xlsItem.Price := GetFloatValue(13);
  471. // 金额
  472. xlsItem.TotalPrice := GetFloatValue(14);
  473. end;
  474. iSerialNo := 1;
  475. end;
  476. procedure InitXMJCodeAndBillsCodeAndName;
  477. begin
  478. strBillsCode := GetBillsCode;
  479. strName := GetName;
  480. if (strBillsCode = '') and (not bCodeEmpty) then
  481. strXMJCode := GetXMJCode
  482. else
  483. strXMJCode := '';
  484. end;
  485. procedure MapXMJCode(AColumn: Integer);
  486. var
  487. strCode: string;
  488. begin
  489. strCode := Trim(VarToStrDef(aSheet.Cells.GetValue(AColumn, iRow), ''));
  490. if strCode <> '' then
  491. begin
  492. while sgsCodes.Count > AColumn do
  493. sgsCodes.Delete(sgsCodes.Count - 1);
  494. sgsCodes.Add(strCode);
  495. bCodeEmpty := False;
  496. end;
  497. end;
  498. procedure MapXMJCodeIntoStrings;
  499. begin
  500. MapXMJCode(0);
  501. MapXMJCode(1);
  502. MapXMJCode(2);
  503. MapXMJCode(3);
  504. MapXMJCode(4);
  505. MapXMJCode(5);
  506. MapXMJCode(6);
  507. end;
  508. procedure ImportRowXMJBillsAndDrawingQuantity;
  509. begin
  510. if IsDrawingQuantity then
  511. AddDrawingQuantity
  512. else
  513. AddXMJBills;
  514. end;
  515. procedure ResetCodeEmpty;
  516. begin
  517. bCodeEmpty := True;
  518. end;
  519. begin
  520. sgsCodes := TStringList.Create;
  521. try
  522. for iRow := 1 to ASheet.Cells.UsedRowCount - 1 do
  523. begin
  524. ResetCodeEmpty;
  525. MapXMJCodeIntoStrings;
  526. InitXMJCodeAndBillsCodeAndName;
  527. ImportRowXMJBillsAndDrawingQuantity;
  528. end;
  529. finally
  530. sgsCodes.Free;
  531. end;
  532. end;
  533. procedure TExcelImportor.ImportExcel;
  534. begin
  535. ExtractSheetCaption;
  536. if not SelectExcelSheet then Exit;
  537. AddProgressForm(10,'正在检测Excel...');
  538. IncProgressUI(10);
  539. InitExcelTree;
  540. AddProgressForm(10,'正在初始化Excel...');
  541. IncProgressUI(10);
  542. ImportSheets;
  543. AddProgressForm(50,'正在导入Excel...');
  544. IncProgressUI(50);
  545. CommitData;
  546. AddProgressForm(20,'正在生成数据...');
  547. IncProgressUI(20);
  548. end;
  549. procedure TExcelImportor.ImportQtyItems;
  550. var
  551. iLoop, iRow: Integer;
  552. ssSheet: TSpreadSheet;
  553. strCode: string;
  554. bReading: Boolean;
  555. dUnitPrice: Double;
  556. begin
  557. FBillsData.BeginImport;
  558. // Added by GiLi 2012-4-18 15:11:11 添加浮动进度条
  559. CreateProgressForm(100, '正在导入工程量清单单价>>>');
  560. try
  561. for iLoop := 0 to FMSExcel.Sheets.Count - 1 do
  562. begin
  563. ssSheet := FMSExcel.Sheets.Spreadsheet(iLoop);
  564. iRow := 0;
  565. bReading := False;
  566. while iRow <= ssSheet.Cells.UsedRowCount - 1 do
  567. begin
  568. strCode := Trim(VarToStrDef(ssSheet.Cells.GetValue(0, iRow), ''));
  569. if not bReading then
  570. begin
  571. if SameText(strCode, '子目号') then
  572. bReading := True;
  573. Inc(iRow);
  574. Continue;
  575. end;
  576. if strCode = '' then
  577. begin
  578. bReading := False;
  579. Inc(iRow);
  580. Continue;
  581. end;
  582. if VarIsNull(ssSheet.Cells.GetValue(4, iRow)) then
  583. dUnitPrice := 0
  584. else
  585. dUnitPrice := StrToFloatDef(Trim(ssSheet.Cells.GetValue(4, iRow)), 0);
  586. AddProgressForm(10, Format('正在导入第%d个Sheet...', [iLoop + 1]));
  587. FBillsData.AssignQtyItemUnitPrice(strCode, dUnitPrice);
  588. Inc(iRow);
  589. end;
  590. end;
  591. finally
  592. CloseFloatProgress;
  593. FBillsData.EndImport;
  594. end;
  595. end;
  596. procedure TExcelImportor.ImportSheet(aSheet: TSpreadSheet);
  597. var
  598. iBeginRow: Integer;
  599. iEndRow : Integer;
  600. iCurRow : Integer;
  601. iSerialNo: Integer;
  602. iCode : Integer;
  603. iErrCode : Integer;
  604. sCode : string;
  605. sB_Code : string;
  606. sName : string;
  607. xlsItem : TScExcelItem;
  608. xlsDQItem: TDrawingQuantityItem;
  609. begin
  610. iBeginRow := GetStartRow(aSheet);
  611. iEndRow := GetEndRow(aSheet);
  612. if (iBeginRow = -1) or (iBeginRow > iEndRow) then
  613. raise Exception.Create(Format('读取工作表[%s]的数据失败, 请检查该表是否有数据或格式是否正确!',
  614. [aSheet.Caption]));
  615. iSerialNo := 1;
  616. for iCurRow := iBeginRow to iEndRow do
  617. begin
  618. sCode := Trim(VarToStrDef(aSheet.Cells.GetValue(0, iCurRow), ''));
  619. sB_Code := Trim(VarToStrDef(aSheet.Cells.GetValue(1, iCurRow), ''));
  620. sName := Trim(VarToStrDef(aSheet.Cells.GetValue(2, iCurRow), ''));
  621. {新需求,只导入一二三部分。 chenshilong, 2013-08-15
  622. [需求描述]导入三级清单后,一二三部分之后的工程量清单位置错误。
  623. 如:102-5交通管制经费跑到第二部分下了,有的跑到第一和第三部分下了。
  624. 如:第三部分之后的项目节导入为第三部分中最后一个节点的设计细目了。
  625. 解决方案为:导入时,读取到“第一、二、三部分 费用合计”这行时,则
  626. 停止导入后面的数据行。}
  627. if SameText(sName, '第一、二、三部分 费用合计') then Break;
  628. DeleteRowBack(sName);
  629. if (sCode = '') and (sB_Code = '') then
  630. begin
  631. if sName = '' then Continue;
  632. xlsDQItem := FExcelTree.AddDrawQuantity;
  633. xlsDQItem.SerinalNo := iSerialNo;
  634. xlsDQItem.Name := sName;
  635. xlsDQItem.Units := VarToStrDef(aSheet.Cells.GetValue(3, iCurRow), '');
  636. if not VarIsNull(aSheet.Cells.GetValue(5, iCurRow)) then
  637. xlsDQItem.DesignQuantity1
  638. := StrToFloatDef(Trim(aSheet.Cells.GetValue(5, iCurRow)), 0);
  639. if not VarIsNull(aSheet.Cells.GetValue(6, iCurRow)) then
  640. xlsDQItem.DesignQuantity2
  641. := StrToFloatDef(Trim(aSheet.Cells.GetValue(6, iCurRow)), 0);
  642. xlsDQItem.MemoContext := VarToStrDef(aSheet.Cells.GetValue(9, iCurRow), '');
  643. Inc(iSerialNo);
  644. end
  645. else
  646. begin
  647. Val(sCode, iCode, iErrCode);
  648. {当大于第三部分时不再导入}
  649. if iCode > 3 then Break;
  650. xlsItem := FExcelTree.AddNodeByCode(sCode, sB_Code);
  651. if not Assigned(xlsItem) then Continue;
  652. iSerialNo := 1;
  653. xlsItem.Name := sName;
  654. xlsItem.Units := VarToStrDef(aSheet.Cells.GetValue(3, iCurRow), '');
  655. if not VarIsNull(aSheet.Cells.GetValue(4, iCurRow)) then
  656. xlsItem.Quantity := StrToFloatDef(Trim(aSheet.Cells.GetValue(4, iCurRow)), 0);
  657. if not VarIsNull(aSheet.Cells.GetValue(5, iCurRow)) then
  658. xlsItem.Quantity1 := StrToFloatDef(Trim(aSheet.Cells.GetValue(5, iCurRow)), 0);
  659. if not VarIsNull(aSheet.Cells.GetValue(6, iCurRow)) then
  660. xlsItem.Quantity2 := StrToFloatDef(Trim(aSheet.Cells.GetValue(6, iCurRow)), 0);
  661. if not VarIsNull(aSheet.Cells.GetValue(7, iCurRow)) then
  662. xlsItem.Price := StrToFloatDef(Trim(aSheet.Cells.GetValue(7, iCurRow)), 0);
  663. if not VarIsNull(aSheet.Cells.GetValue(8, iCurRow)) then
  664. xlsItem.TotalPrice := StrToFloatDef(Trim(aSheet.Cells.GetValue(8, iCurRow)), 0);
  665. xlsItem.MemoString := VarToStrDef(aSheet.Cells.GetValue(9, iCurRow), '');
  666. end;
  667. end;
  668. end;
  669. procedure TExcelImportor.ImportSheets;
  670. var
  671. I: Integer;
  672. iSheet: Integer;
  673. ssSheet: TSpreadSheet;
  674. begin
  675. for I := 0 to FCaptions.Count - 1 do
  676. begin
  677. iSheet := Integer(FCaptions.Objects[I]);
  678. ssSheet := FMSExcel.Sheets.Spreadsheet(iSheet);
  679. if IsBalanceFormat(ssSheet) then
  680. ImportBalanceSheet(ssSheet)
  681. else
  682. if Is01_1Excel(ssSheet) then // Added by GiLi 可以导入01-1表
  683. Import01_1Excel(ssSheet)
  684. else
  685. ImportSheet(ssSheet);
  686. end;
  687. end;
  688. procedure TExcelImportor.InitExcelTree;
  689. begin
  690. FExcelTree.ViewBillTreeParts;
  691. FExcelTree.AddFirstNode(FBillsData.BillsTree.FirstNode.ID);
  692. FExcelTree.MaxNodeID := FBillsData.GetMaxBillsID;
  693. FExcelTree.MaxDrawQID := FBillsData.GetMaxDrawingQuangtiyID;
  694. end;
  695. procedure TExcelImportor.InitSpecialItems(ASpecialItems: TStrings);
  696. begin
  697. with ASpecialItems do
  698. begin
  699. Add('第一部分建筑安装工程费');
  700. Add('第二部分设备及工具、器具购置费');
  701. Add('第三部分工程建设其他费用');
  702. Add('第一、二、三部分费用合计');
  703. Add('预备费');
  704. Add('预留费用');
  705. Add('新增加费用项目(不作预备费基数)');
  706. Add('其中:回收金额');
  707. Add('预算总金额');
  708. Add('概算总金额');
  709. Add('公路基本造价');
  710. Add('1.价差预备费');
  711. Add('1.价差预留费');
  712. Add('2.基本预备费');
  713. Add('2.暂列金额(不含计日工总额)');
  714. Add('建设期贷款利息');
  715. Add('公路功能以外的工程费用(如有)');
  716. Add('项目总造价');
  717. Add('其他费用项目');
  718. end;
  719. end;
  720. function TExcelImportor.Is01_1Excel(ASheet: TSpreadSheet): Boolean;
  721. begin
  722. Result := (ASheet.Cells.UsedRowCount > 0) and (ASheet.Cells.UsedColCount > 5);
  723. if Result then
  724. Result := SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(0, 3), '')), '项') and
  725. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(1, 3), '')), '目') and
  726. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(2, 3), '')), '节') and
  727. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(3, 3), '')), '细目') and
  728. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(4, 3), '')), '清单子目号');
  729. end;
  730. function TExcelImportor.IsBalanceFormat(ASheet: TSpreadSheet): Boolean;
  731. begin
  732. Result := (ASheet.Cells.UsedRowCount > 0) and (ASheet.Cells.UsedColCount > 7);
  733. if Result then
  734. Result := SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(0, 0), '')), '项') and
  735. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(1, 0), '')), '目') and
  736. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(2, 0), '')), '节') and
  737. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(3, 0), '')), '分项1') and
  738. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(4, 0), '')), '分项2') and
  739. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(5, 0), '')), '分项3') and
  740. SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(6, 0), '')), '分项4');
  741. end;
  742. function TExcelImportor.IsSpecialItem(const AString: string): Boolean;
  743. var
  744. I: Integer;
  745. begin
  746. if not Assigned(FSpecialItems) then
  747. begin
  748. Result := False;
  749. Exit;
  750. end;
  751. if FSpecialItems.Count = 0 then
  752. begin
  753. Result := False;
  754. Exit;
  755. end;
  756. for I:=0 to FSpecialItems.Count - 1 do
  757. begin
  758. if SameText(AString, FSpecialItems[I]) then
  759. begin
  760. Result := True;
  761. Exit;
  762. end;
  763. end;
  764. Result := False;
  765. end;
  766. function TExcelImportor.SelectExcelSheet: Boolean;
  767. begin
  768. Result := ExportExFrm.SelectExcelSheet(FCaptions);
  769. if Result and (FCaptions.Count = 0) then
  770. begin
  771. Result := False;
  772. raise Exception.Create('选择工作表个数为0, 没有执行导入Excel操作.');
  773. end;
  774. end;
  775. end.