Excel Automation: Multi-sheet books - Create and Update

aisnet
Member Posts: 4
Hello all,
A few days ago I tried to find information about the multi-sheets Excel automation, not only to create, but to update multi-sheet Excel documents. Unfortunately, I couldn't find much about this, so I made my own way using information from mibuso and other forums, and finally, with all the information, I did find a solution for my customer's needs. I hope this can help much more other people with similar issues.
Solution: With the Table 370 / NAV 4.0
NOTE: In these samples, the number of sheets are limited to 28.
OpenMultiBook Code:
OpenMultiBook(FileName : Text[1024];SheetsNames : ARRAY [28] OF Text[250];OpenToRead : Boolean)
IF FileName = '' THEN
ERROR(Text001);
IF SheetsNames[1] = '' THEN
ERROR(Text002);
IF NOT EXISTS(FileName) THEN
ERROR(Text003,FileName);
IF NOT CREATE(XlApp,TRUE) THEN
ERROR(Text000);
XlApp.Workbooks._Open(FileName);
XlWrkBk := XlApp.ActiveWorkbook;
EndOfLoop := XlWrkBk.Worksheets.Count;
i := 1;
WHILE i <= EndOfLoop DO BEGIN
XlWrkshts := XlWrkBk.Worksheets.Item(i);
FOR j := 1 TO 28 DO BEGIN
IF SheetsNames[j] = XlWrkshts.Name THEN BEGIN
Found := TRUE;
XlWrkSht := XlWrkBk.Worksheets.Item(XlWrkshts.Name);
IF OpenToRead THEN
ReadMultiBookSheet(XlWrkshts.Name);
END;
END;
i += 1;
END;
IF NOT Found THEN BEGIN
XlWrkBk.Close(FALSE);
XlApp.Quit;
CLEAR(XlApp);
ERROR(AISNETText000);
END;
ReadMultiBookSheet Code:
ReadMultiBookSheet(SheetName : Text[250])
Window.OPEN(
Text007 +
'@\');
Window.UPDATE(1,0);
DELETEALL;
XlRange := XlWrkSht.Range(GetExcelReference(5)).SpecialCells(11);
Maxi := XlRange.Row;
Maxj := XlRange.Column;
i := 1;
REPEAT
j := 1;
VALIDATE("Row No.",i);
REPEAT
VALIDATE("Column No.",j);
"Cell Value as Text" := DELCHR(FORMAT(XlWrkSht.Range(xlColID + xlRowID).Value),'<',' ');
IF "Cell Value as Text" <> '' THEN
INSERT;
WorksheetName := SheetName;
j := j + 1;
UNTIL j > Maxj;
i := i + 1;
Window.UPDATE(1,ROUND(i / Maxi * 10000,1));
UNTIL i > Maxi;
XlWrkBk.Close(FALSE);
XlApp.Quit;
CLEAR(XlApp);
Window.CLOSE;
CreateMultiSheet Code:
CreateMultiSheet(ReportHeader : Text[80];CompanyName : Text[30];UserID2 : Text[30];UseAdditionalData : Boolean)
Window.OPEN(
Text005 +
'@\');
Window.UPDATE(1,0);
XlEdgeBottom := 9;
XlContinuous := 1;
XlLineStyleNone := -4142;
XlLandscape := 2;
CRLF := 10;
RecNo := 1;
TotalRecNo := COUNTAPPROX + InfoExcelBuf.COUNTAPPROX;
RecNo := 0;
LastWorksheetName := '';
IF FINDFIRST THEN BEGIN
REPEAT
RecNo := RecNo + 1;
Window.UPDATE(1,ROUND(RecNo / TotalRecNo * 10000,1));
IF LastWorksheetName <> WorksheetName THEN BEGIN
XlWrkSht := XlWrkBk.Worksheets.Add();
XlWrkSht.Name := WorksheetName;
IF UseAdditionalData THEN BEGIN
IF ReportHeader <> '' THEN
XlWrkSht.PageSetup.LeftHeader :=
STRSUBSTNO('%1%2%1%3%4',GetExcelReference(1),ReportHeader,CRLF,CompanyName);
XlWrkSht.PageSetup.RightHeader :=
STRSUBSTNO(Text006,GetExcelReference(2),GetExcelReference(3),CRLF,UserID2);
END;
XlWrkSht.PageSetup.Orientation := XlLandscape;
END;
IF NumberFormat <> '' THEN
XlWrkSht.Range(xlColID + xlRowID).NumberFormat := NumberFormat;
IF Formula = '' THEN
XlWrkSht.Range(xlColID + xlRowID).Value := "Cell Value as Text"
ELSE
XlWrkSht.Range(xlColID + xlRowID).Formula := GetFormula;
IF Comment <> '' THEN
XlWrkSht.Range(xlColID + xlRowID).AddComment := Comment;
IF Bold THEN
XlWrkSht.Range(xlColID + xlRowID).Font.Bold := Bold;
IF Italic THEN
XlWrkSht.Range(xlColID + xlRowID).Font.Italic := Italic;
XlWrkSht.Range(xlColID + xlRowID).Borders.LineStyle := XlLineStyleNone;
IF Underline THEN
XlWrkSht.Range(xlColID + xlRowID).Borders.Item(XlEdgeBottom).LineStyle := XlContinuous;
LastWorksheetName := WorksheetName;
UNTIL NEXT = 0;
XlWrkSht.Range(GetExcelReference(5) + ':' + xlColID + xlRowID).Columns.AutoFit;
END;
Window.CLOSE
UpdateMultiSheet Code:
UpdateMultiSheet(vFileName : Text[1024];SheetsNames : ARRAY [28] OF Text[250])
RESET;
IF vFileName = '' THEN
ERROR(Text001);
IF NOT EXISTS(vFileName) THEN
ERROR(Text003, vFileName);
IF NOT CREATE(XlApp, TRUE) THEN
ERROR(Text000);
XlApp.Workbooks._Open(vFileName);
XlWrkBk := XlApp.ActiveWorkbook;
EndOfLoop := XlWrkBk.Worksheets.Count;
i := 1;
Found := TRUE;
WHILE i <= EndOfLoop DO BEGIN
XlWrkshts := XlWrkBk.Worksheets.Item(i);
FOR j := 1 TO 28 DO BEGIN
IF SheetsNames[j] = XlWrkshts.Name THEN BEGIN
Found := TRUE;
j := 28;
END ELSE
IF j = 28 THEN
Found := FALSE;
END;
i += 1;
END;
IF NOT Found THEN BEGIN
XlWrkBk.Close(FALSE);
XlApp.Quit;
CLEAR(XlApp);
ERROR(AISNETText000);
END;
Window.OPEN(
Text005 +
'@\');
Window.UPDATE(1,0);
RecNo := 1;
TotalRecNo := COUNTAPPROX;
RecNo := 0;
IF FINDFIRST THEN REPEAT
RecNo := RecNo + 1;
Window.UPDATE(1, ROUND(RecNo / TotalRecNo * 10000, 1));
XlWrkSht := XlWrkBk.Worksheets.Item(WorksheetName);
IF NumberFormat <> '' THEN
XlWrkSht.Range(xlColID + xlRowID).NumberFormat := NumberFormat;
IF Formula = '' THEN
XlWrkSht.Range(xlColID + xlRowID).Value := "Cell Value as Text"
ELSE
XlWrkSht.Range(xlColID + xlRowID).Formula := GetFormula;
UNTIL NEXT = 0;
Window.CLOSE
Load Table 370 With Multi-sheet Data
You may call this code from any place or procedure in order to fill the excel buffer with your data.
EnterCell(RowNo : Integer;ColumnNo : Integer;CellValue : Text[4];WorkSheet : Text[250])
WITH ExclBuffer DO BEGIN
INIT;
VALIDATE("Row No.",RowNo);
VALIDATE("Column No.",ColumnNo);
"Cell Value as Text" := CellValue;
WorksheetName := WorkSheet;
WorksheetNo := GetWorkSheetIndex(WorkSheet);
INSERT;
END;
GetWorkSheetIndex Code: (SAMPLE to get an assigned sheet index)
GetWorkSheetIndex(WorkSheetName : Text[15]) : Integer
CASE WorkSheetName OF
'ALTA POST': EXIT(1);
'PORTA': EXIT(2);
'IEW': EXIT(4);
'IPLUS': EXIT(5);
'BBRES': EXIT(6);
'OW': EXIT(7);
'MIG': EXIT(8);
'NIF': EXIT(9);
'CIF': EXIT(10);
'IEWPRO': EXIT(11);
'BB': EXIT(12);
'WM': EXIT(13);
'TPN': EXIT(14);
'ORANGE ULL': EXIT(16);
'YA': EXIT(17);
'GIGA': EXIT(19);
'ISE': EXIT(21);
'FUS': EXIT(22);
'RENOVE': EXIT(23);
'REN EMP': EXIT(24);
'ALTA PRE': EXIT(25);
'PORTA PRE': EXIT(26);
'O CARE': EXIT(28);
END;
Excecuting Update Code: SAMPLE
ExclBuffer.UpdateMultiSheet(vExcelFile, vWorkSheets);
Where "vWorkSheets" is an array with all the worksheets in a multi-sheets workbook.
:thumbsup: Happy coding!
Pablo Passero - AISNET
http://www.aisnet.eu
A few days ago I tried to find information about the multi-sheets Excel automation, not only to create, but to update multi-sheet Excel documents. Unfortunately, I couldn't find much about this, so I made my own way using information from mibuso and other forums, and finally, with all the information, I did find a solution for my customer's needs. I hope this can help much more other people with similar issues.
Solution: With the Table 370 / NAV 4.0
-
Create two new fields called "WorksheetName" and "WorksheetNo"
-
Add "WorksheetName" to the primary key (this will not affect any other standard functionality)
-
- "WorksheetName" will be used to identify the destination sheet name in a Workbook
-
- "WorksheetName" can be used to identify and select a destination sheet name en a Workbook too
-
- "WorksheetNo" can be used to identify and select a destination sheet name en a Workbook too
-
Create the following functions:
-
-OpenMultiBook: Open a multi-sheets workbook
-
-ReadMultiBookSheet: Reads all the sheets in a multi-sheets workbook
-
-CreateMultiSheet: Creates sheets into a NEW multi-sheets workbook
-
-UpdateMultiSheet: Updates sheets into an EXISTENT multi-sheets workbook
NOTE: In these samples, the number of sheets are limited to 28.
OpenMultiBook Code:
OpenMultiBook(FileName : Text[1024];SheetsNames : ARRAY [28] OF Text[250];OpenToRead : Boolean)
IF FileName = '' THEN
ERROR(Text001);
IF SheetsNames[1] = '' THEN
ERROR(Text002);
IF NOT EXISTS(FileName) THEN
ERROR(Text003,FileName);
IF NOT CREATE(XlApp,TRUE) THEN
ERROR(Text000);
XlApp.Workbooks._Open(FileName);
XlWrkBk := XlApp.ActiveWorkbook;
EndOfLoop := XlWrkBk.Worksheets.Count;
i := 1;
WHILE i <= EndOfLoop DO BEGIN
XlWrkshts := XlWrkBk.Worksheets.Item(i);
FOR j := 1 TO 28 DO BEGIN
IF SheetsNames[j] = XlWrkshts.Name THEN BEGIN
Found := TRUE;
XlWrkSht := XlWrkBk.Worksheets.Item(XlWrkshts.Name);
IF OpenToRead THEN
ReadMultiBookSheet(XlWrkshts.Name);
END;
END;
i += 1;
END;
IF NOT Found THEN BEGIN
XlWrkBk.Close(FALSE);
XlApp.Quit;
CLEAR(XlApp);
ERROR(AISNETText000);
END;
ReadMultiBookSheet Code:
ReadMultiBookSheet(SheetName : Text[250])
Window.OPEN(
Text007 +
'@\');
Window.UPDATE(1,0);
DELETEALL;
XlRange := XlWrkSht.Range(GetExcelReference(5)).SpecialCells(11);
Maxi := XlRange.Row;
Maxj := XlRange.Column;
i := 1;
REPEAT
j := 1;
VALIDATE("Row No.",i);
REPEAT
VALIDATE("Column No.",j);
"Cell Value as Text" := DELCHR(FORMAT(XlWrkSht.Range(xlColID + xlRowID).Value),'<',' ');
IF "Cell Value as Text" <> '' THEN
INSERT;
WorksheetName := SheetName;
j := j + 1;
UNTIL j > Maxj;
i := i + 1;
Window.UPDATE(1,ROUND(i / Maxi * 10000,1));
UNTIL i > Maxi;
XlWrkBk.Close(FALSE);
XlApp.Quit;
CLEAR(XlApp);
Window.CLOSE;
CreateMultiSheet Code:
CreateMultiSheet(ReportHeader : Text[80];CompanyName : Text[30];UserID2 : Text[30];UseAdditionalData : Boolean)
Window.OPEN(
Text005 +
'@\');
Window.UPDATE(1,0);
XlEdgeBottom := 9;
XlContinuous := 1;
XlLineStyleNone := -4142;
XlLandscape := 2;
CRLF := 10;
RecNo := 1;
TotalRecNo := COUNTAPPROX + InfoExcelBuf.COUNTAPPROX;
RecNo := 0;
LastWorksheetName := '';
IF FINDFIRST THEN BEGIN
REPEAT
RecNo := RecNo + 1;
Window.UPDATE(1,ROUND(RecNo / TotalRecNo * 10000,1));
IF LastWorksheetName <> WorksheetName THEN BEGIN
XlWrkSht := XlWrkBk.Worksheets.Add();
XlWrkSht.Name := WorksheetName;
IF UseAdditionalData THEN BEGIN
IF ReportHeader <> '' THEN
XlWrkSht.PageSetup.LeftHeader :=
STRSUBSTNO('%1%2%1%3%4',GetExcelReference(1),ReportHeader,CRLF,CompanyName);
XlWrkSht.PageSetup.RightHeader :=
STRSUBSTNO(Text006,GetExcelReference(2),GetExcelReference(3),CRLF,UserID2);
END;
XlWrkSht.PageSetup.Orientation := XlLandscape;
END;
IF NumberFormat <> '' THEN
XlWrkSht.Range(xlColID + xlRowID).NumberFormat := NumberFormat;
IF Formula = '' THEN
XlWrkSht.Range(xlColID + xlRowID).Value := "Cell Value as Text"
ELSE
XlWrkSht.Range(xlColID + xlRowID).Formula := GetFormula;
IF Comment <> '' THEN
XlWrkSht.Range(xlColID + xlRowID).AddComment := Comment;
IF Bold THEN
XlWrkSht.Range(xlColID + xlRowID).Font.Bold := Bold;
IF Italic THEN
XlWrkSht.Range(xlColID + xlRowID).Font.Italic := Italic;
XlWrkSht.Range(xlColID + xlRowID).Borders.LineStyle := XlLineStyleNone;
IF Underline THEN
XlWrkSht.Range(xlColID + xlRowID).Borders.Item(XlEdgeBottom).LineStyle := XlContinuous;
LastWorksheetName := WorksheetName;
UNTIL NEXT = 0;
XlWrkSht.Range(GetExcelReference(5) + ':' + xlColID + xlRowID).Columns.AutoFit;
END;
Window.CLOSE
UpdateMultiSheet Code:
UpdateMultiSheet(vFileName : Text[1024];SheetsNames : ARRAY [28] OF Text[250])
RESET;
IF vFileName = '' THEN
ERROR(Text001);
IF NOT EXISTS(vFileName) THEN
ERROR(Text003, vFileName);
IF NOT CREATE(XlApp, TRUE) THEN
ERROR(Text000);
XlApp.Workbooks._Open(vFileName);
XlWrkBk := XlApp.ActiveWorkbook;
EndOfLoop := XlWrkBk.Worksheets.Count;
i := 1;
Found := TRUE;
WHILE i <= EndOfLoop DO BEGIN
XlWrkshts := XlWrkBk.Worksheets.Item(i);
FOR j := 1 TO 28 DO BEGIN
IF SheetsNames[j] = XlWrkshts.Name THEN BEGIN
Found := TRUE;
j := 28;
END ELSE
IF j = 28 THEN
Found := FALSE;
END;
i += 1;
END;
IF NOT Found THEN BEGIN
XlWrkBk.Close(FALSE);
XlApp.Quit;
CLEAR(XlApp);
ERROR(AISNETText000);
END;
Window.OPEN(
Text005 +
'@\');
Window.UPDATE(1,0);
RecNo := 1;
TotalRecNo := COUNTAPPROX;
RecNo := 0;
IF FINDFIRST THEN REPEAT
RecNo := RecNo + 1;
Window.UPDATE(1, ROUND(RecNo / TotalRecNo * 10000, 1));
XlWrkSht := XlWrkBk.Worksheets.Item(WorksheetName);
IF NumberFormat <> '' THEN
XlWrkSht.Range(xlColID + xlRowID).NumberFormat := NumberFormat;
IF Formula = '' THEN
XlWrkSht.Range(xlColID + xlRowID).Value := "Cell Value as Text"
ELSE
XlWrkSht.Range(xlColID + xlRowID).Formula := GetFormula;
UNTIL NEXT = 0;
Window.CLOSE
Load Table 370 With Multi-sheet Data
You may call this code from any place or procedure in order to fill the excel buffer with your data.
EnterCell(RowNo : Integer;ColumnNo : Integer;CellValue : Text[4];WorkSheet : Text[250])
WITH ExclBuffer DO BEGIN
INIT;
VALIDATE("Row No.",RowNo);
VALIDATE("Column No.",ColumnNo);
"Cell Value as Text" := CellValue;
WorksheetName := WorkSheet;
WorksheetNo := GetWorkSheetIndex(WorkSheet);
INSERT;
END;
GetWorkSheetIndex Code: (SAMPLE to get an assigned sheet index)
GetWorkSheetIndex(WorkSheetName : Text[15]) : Integer
CASE WorkSheetName OF
'ALTA POST': EXIT(1);
'PORTA': EXIT(2);
'IEW': EXIT(4);
'IPLUS': EXIT(5);
'BBRES': EXIT(6);
'OW': EXIT(7);
'MIG': EXIT(8);
'NIF': EXIT(9);
'CIF': EXIT(10);
'IEWPRO': EXIT(11);
'BB': EXIT(12);
'WM': EXIT(13);
'TPN': EXIT(14);
'ORANGE ULL': EXIT(16);
'YA': EXIT(17);
'GIGA': EXIT(19);
'ISE': EXIT(21);
'FUS': EXIT(22);
'RENOVE': EXIT(23);
'REN EMP': EXIT(24);
'ALTA PRE': EXIT(25);
'PORTA PRE': EXIT(26);
'O CARE': EXIT(28);
END;
Excecuting Update Code: SAMPLE
ExclBuffer.UpdateMultiSheet(vExcelFile, vWorkSheets);
Where "vWorkSheets" is an array with all the worksheets in a multi-sheets workbook.
:thumbsup: Happy coding!
Pablo Passero - AISNET
http://www.aisnet.eu
0
Comments
-
Thank you for a very good post! :thumbsup:0
Categories
- All Categories
- 73 General
- 73 Announcements
- 66.6K Microsoft Dynamics NAV
- 18.7K NAV Three Tier
- 38.4K NAV/Navision Classic Client
- 3.6K Navision Attain
- 2.4K Navision Financials
- 116 Navision DOS
- 851 Navision e-Commerce
- 1K NAV Tips & Tricks
- 772 NAV Dutch speaking only
- 617 NAV Courses, Exams & Certification
- 2K Microsoft Dynamics-Other
- 1.5K Dynamics AX
- 320 Dynamics CRM
- 111 Dynamics GP
- 10 Dynamics SL
- 1.5K Other
- 990 SQL General
- 383 SQL Performance
- 34 SQL Tips & Tricks
- 35 Design Patterns (General & Best Practices)
- 1 Architectural Patterns
- 10 Design Patterns
- 5 Implementation Patterns
- 53 3rd Party Products, Services & Events
- 1.6K General
- 1.1K General Chat
- 1.6K Website
- 83 Testing
- 1.2K Download section
- 23 How Tos section
- 252 Feedback
- 12 NAV TechDays 2013 Sessions
- 13 NAV TechDays 2012 Sessions