├── ExcelXML ├── sample01.SCT ├── sample01.scx ├── sample02.SCT ├── sample02.scx ├── sample03.SCT ├── sample03.scx ├── sample04.SCT ├── sample04.scx ├── sample05.FXP ├── images │ ├── sample01.png │ ├── sample02.png │ ├── sample03.png │ ├── sample04.png │ ├── sample01_excel.png │ ├── sample02_excel.png │ ├── sample03_excel.png │ └── sample04_excel.png ├── sample01_noprogressbar.SCT ├── sample01_noprogressbar.scx ├── sample02_noprogressbar.SCT ├── sample02_noprogressbar.scx ├── sample03_noprogressbar.SCT ├── sample03_noprogressbar.scx ├── sample04_noprogressbar.SCT ├── sample04_noprogressbar.scx ├── vfpxpoweredby_alternative.gif └── sample05.prg ├── ExcelXML_method_vs.bmp ├── ExcelXML_sample01.png ├── ExcelXML_sample02.png ├── ExcelXML_sample03.png ├── ExcelXML_sample04.png ├── ExcelXML_property_vs.bmp ├── ExcelXML_sample01_excel.png ├── ExcelXML_sample02_excel.png ├── ExcelXML_sample03_excel.png ├── ExcelXML_sample04_excel.png ├── .gitignore ├── README.md └── ExcelXML.prg /ExcelXML/sample01.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample01.SCT -------------------------------------------------------------------------------- /ExcelXML/sample01.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample01.scx -------------------------------------------------------------------------------- /ExcelXML/sample02.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample02.SCT -------------------------------------------------------------------------------- /ExcelXML/sample02.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample02.scx -------------------------------------------------------------------------------- /ExcelXML/sample03.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample03.SCT -------------------------------------------------------------------------------- /ExcelXML/sample03.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample03.scx -------------------------------------------------------------------------------- /ExcelXML/sample04.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample04.SCT -------------------------------------------------------------------------------- /ExcelXML/sample04.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample04.scx -------------------------------------------------------------------------------- /ExcelXML/sample05.FXP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample05.FXP -------------------------------------------------------------------------------- /ExcelXML_method_vs.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_method_vs.bmp -------------------------------------------------------------------------------- /ExcelXML_sample01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample01.png -------------------------------------------------------------------------------- /ExcelXML_sample02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample02.png -------------------------------------------------------------------------------- /ExcelXML_sample03.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample03.png -------------------------------------------------------------------------------- /ExcelXML_sample04.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample04.png -------------------------------------------------------------------------------- /ExcelXML_property_vs.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_property_vs.bmp -------------------------------------------------------------------------------- /ExcelXML_sample01_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample01_excel.png -------------------------------------------------------------------------------- /ExcelXML_sample02_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample02_excel.png -------------------------------------------------------------------------------- /ExcelXML_sample03_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample03_excel.png -------------------------------------------------------------------------------- /ExcelXML_sample04_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML_sample04_excel.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.bak 2 | *.fxp 3 | FOXUSER.* 4 | *_ref.* 5 | .hg 6 | /.hgignore 7 | DeployDynamicForm.ps1 8 | -------------------------------------------------------------------------------- /ExcelXML/images/sample01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample01.png -------------------------------------------------------------------------------- /ExcelXML/images/sample02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample02.png -------------------------------------------------------------------------------- /ExcelXML/images/sample03.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample03.png -------------------------------------------------------------------------------- /ExcelXML/images/sample04.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample04.png -------------------------------------------------------------------------------- /ExcelXML/images/sample01_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample01_excel.png -------------------------------------------------------------------------------- /ExcelXML/images/sample02_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample02_excel.png -------------------------------------------------------------------------------- /ExcelXML/images/sample03_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample03_excel.png -------------------------------------------------------------------------------- /ExcelXML/images/sample04_excel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/images/sample04_excel.png -------------------------------------------------------------------------------- /ExcelXML/sample01_noprogressbar.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample01_noprogressbar.SCT -------------------------------------------------------------------------------- /ExcelXML/sample01_noprogressbar.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample01_noprogressbar.scx -------------------------------------------------------------------------------- /ExcelXML/sample02_noprogressbar.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample02_noprogressbar.SCT -------------------------------------------------------------------------------- /ExcelXML/sample02_noprogressbar.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample02_noprogressbar.scx -------------------------------------------------------------------------------- /ExcelXML/sample03_noprogressbar.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample03_noprogressbar.SCT -------------------------------------------------------------------------------- /ExcelXML/sample03_noprogressbar.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample03_noprogressbar.scx -------------------------------------------------------------------------------- /ExcelXML/sample04_noprogressbar.SCT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample04_noprogressbar.SCT -------------------------------------------------------------------------------- /ExcelXML/sample04_noprogressbar.scx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/sample04_noprogressbar.scx -------------------------------------------------------------------------------- /ExcelXML/vfpxpoweredby_alternative.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VFPX/ExcelXML/HEAD/ExcelXML/vfpxpoweredby_alternative.gif -------------------------------------------------------------------------------- /ExcelXML/sample05.prg: -------------------------------------------------------------------------------- 1 | */ Converts a cursor in a Excel XML file without a Grid control 2 | 3 | create cursor students ( name c(30), birthday d null, age n(3) ) 4 | insert into students values ( "Brian", date(1500,01,01), 7 ) 5 | insert into students values ( "Megan", date(), 0 ) 6 | insert into students values ( "Melanie", date(1945,03,25), 59 ) 7 | insert into students values ( "Stephanie", date(1978,05,24), 35 ) 8 | insert into students values ( "Angelina", date(2011,06,19), 2 ) 9 | insert into students values ( "Richard", date(1995,01,13), 13 ) 10 | insert into students values ( "Michael", date(1982,03,24), 31 ) 11 | insert into students values ( "Ingrid", date(2005,11,18), 7 ) 12 | insert into students values ( "Michelle", date(1978,12,15), 34 ) 13 | insert into students values ( "Ryan", date(1999,09,05), 14 ) 14 | insert into students values ( "Brian", date(2005,11,27), 7 ) 15 | insert into students values ( "Megan", date(2001,03,30), 12 ) 16 | insert into students values ( "Melanie", date(1954,02,28), 59 ) 17 | insert into students values ( "Stephanie", date(1978,05,24), 35 ) 18 | insert into students values ( "Angelina", date(2011,06,19), 2 ) 19 | insert into students values ( "Richard", date(1995,01,13), 13 ) 20 | insert into students values ( "Michael", date(1982,03,24), 31 ) 21 | insert into students values ( "Ingrid", date(2005,11,18), 7 ) 22 | insert into students values ( "Michelle", date(1978,12,15), 34 ) 23 | insert into students values ( "Ryan", date(1999,09,05), 14 ) 24 | 25 | local loExcelXML, llOk 26 | loExcelXML = NewObject("ExcelXML","..\ExcelXML.prg") 27 | loExcelXML.SheetName = "Students Grade 5A" 28 | loExcelXML.OpenAfterSaving = .t. 29 | llOk = loExcelXML.Save("Sample05.XML") 30 | 31 | 32 | 33 | 34 | if llOk 35 | messagebox("File saved", 64) 36 | else 37 | messagebox("File not saved", 16) 38 | endif 39 | 40 | use in students 41 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ExcelXML 2 | **Export a Table/Cursor/Alias or Grid control into a Microsoft Excel XML Spreadsheet file, or XLS/XLSX.** 3 | 4 | Original author: Rodrigo Bruscain 5 | 6 | The ExcelXML project brings to Visual FoxPro the ability to generate an Excel file from a grid or table/cursor/alias. When used with a grid, it attempts to export 99% of all visual caracteristics from the Grid. It can also export directly from a cursor/alias, without requiring a grid. 7 | 8 | This tool produces an Excel XML file using only VFP code to generate the XML markup. This file can be opened by Excel or other open source spreadsheet tools. It can also convert the XML file to an .XLS or .XLSX file, but requires Excel to do the conversion. 9 | 10 | ## NOTE: 11 | [2017-09-03] Extracted original VCX to PRG to allow better updating of the source code by the VFP community on GitHib since it's a raw code file rather than a binary VCX. [by Matt Slay] 12 | 13 | ## Goals 14 | * Excel files with over 65,535 rows. 15 | * No limit size (it depends on the Operating System). 16 | * Convert a Grid Control into a Excel XML file considering 99% of the visual characteristics. 17 | * It is possible to use Grid Dynamics properties. 18 | * Attempts to honor (export) all Grid visual properties. 19 | * It is possible to convert a table/cursor/alias without requiring a Grid Control. 20 | * Easy to implement and it is not necessary to change your code. 21 | * Compatible with Microsoft Excel 2003 or higher. 22 | * The files can be opened by OpenOffice reducing conversion errors. 23 | * Open the file by Excel and save in other formats to reduce the size without losing information. 24 | * It is not necessary to have Microsoft Excel installed. 25 | 26 | **Release version 1.10 (2017-09-10)** 27 | Added new method: ConvertXmlToXlsx(tcFilename, tnFileFormat, tlOpenAfterExporting) 28 | Added new properties for ColumnHeaderBackgroundColor and ColumnHeaderForeColor 29 | Added new property GridClass to use when creating a temporary form to create grid to host the cursor/alias during the export. 30 | FIX - Fixed bug in Bottom Border logic if cursor/grid only has 1 row of data. 31 | 32 | **Release version 1.09 (2017-09-03)** 33 | Added Try/Catch blocks to handle the various Dynamic properties which may not evaluate properly in some cases. 34 | 35 | **Release version 1.08** 36 | NEW - Document author included as username or computername. 37 | FIX - Field Date and DateTime with the year lower than 1900 will be forced to 1900. This is necessary because the lower allowed year in a cell of Excel is 1900 38 | FIX - Automatic column width for fields type char bigger that 190 columns 39 | 40 | **Release version 1.07** 41 | FIX - Data with the characters "<" or ">" are replaced for {""[" and "](_-and-_)""} in order to avoid data conflict during the conversion. 42 | FIX - Alias error when the property "RecordSourceType" in the Grid control is diferent than 1. 43 | FIX - Included samples with no progressbar in order to avoid the error ole 0x80040154. This error happens only in some machines that the ActiveX ProgressBar doesn't exists. 44 | 45 | **Release version 1.06** 46 | FIX - SET COLLATE TO controled at run-time to avoid the error "Invalid Key Length" 47 | 48 | **Release version 1.05** 49 | FIX - Column data type Date and DateTime when converted has wrong format. 50 | FIX - Column data type DateTime is not considered the time in current value field. 51 | 52 | **Release version 1.04** 53 | FIX - Sheet name cannot exceed 31 characters 54 | FIX - Sheet name cannot contain any of the following characteres: {" : \ / ? * [ ](--)"} 55 | FIX - Sheet name cannot be blank. If is blank, will be changed to "Sheet1" 56 | 57 | **Release version 1.03** 58 | FIX - Field Date/Datetime with NULL or EMPTY value builds a Excel file incorrectly. 59 | FIX - Index error when the index tag is too big. 60 | 61 | | Properties | Description | 62 | | -----------------------|-------------| 63 | |![](ExcelXML_property_vs.bmp) Alias | Sets the cursor/alias name to export to an Excel XML file. This is used if the GridObject property is not set.| 64 | |![](ExcelXML_property_vs.bmp) ColumnCount | Returns the number of columns included in the Excel file.| 65 | |![](ExcelXML_property_vs.bmp) ColumnHeaderBackgroundColor | Colmn Header Background color. Can override grid header backcolor. Set to a string with Hex value, like "#CCCCCC" for light gray.| 66 | |![](ExcelXML_property_vs.bmp) ColumnHeaderForeColor | Colmn Header ForeColor. Can override grid header forecolor. Set to a string with Hex value, like "#000000" for black.| 67 | |![](ExcelXML_property_vs.bmp) File | Inform the name of Excel file. If you don't inform the name with the extension, the XML extension will be included. The default file name is "Book1"| 68 | |![](ExcelXML_property_vs.bmp) GridObject | Identifies the Grid object to exported to an Excel XML file. RecordSource property on Grid should already be set.| 69 | |![](ExcelXML_property_vs.bmp) HasFilter | .T. Includes the option Filter in all columns in the generated file.| 70 | |![](ExcelXML_property_vs.bmp) LockHeader | .T. locks the header in the generated file. This option in Excel is called by Freeze Top Row.| 71 | |![](ExcelXML_property_vs.bmp) OpenAfterSaving | .T. to open the file after saving it.| 72 | |![](ExcelXML_property_vs.bmp) RowCount | Returns the number of rows included in the Excel file.| 73 | |![](ExcelXML_property_vs.bmp) SetStyles | .T. to define that the Excel file will have the Grid visual characteristics transported.| 74 | |![](ExcelXML_property_vs.bmp) SheetName | Excel sheet name. The default name is "Sheet1"| 75 | |![](ExcelXML_property_vs.bmp) xmlEncoding | XML encoding type used to set the code that defines special characters. Default code is "iso-8859-1".| 76 | |![](ExcelXML_property_vs.bmp) Version | Object that contains the information about this class.| 77 | 78 | 79 | | Methods | Description | 80 | | -----------------------|-------------| 81 | |![](ExcelXML_method_vs.bmp) About|About ExcelXML class| 82 | |![](ExcelXML_method_vs.bmp) Progress|Method used to show the percentage processed.| 83 | |![](ExcelXML_method_vs.bmp) Save|Creates the Excel XML file.| 84 | |![](ExcelXML_method_vs.bmp) ConvertXmlToXlsx|Converts the created Excel XML file to XLS or XLSX format using Excel.| 85 | 86 | ## Sample 01 87 | ![](ExcelXML_sample01.png) 88 | 89 | ![](ExcelXML_sample01_excel.png) 90 | 91 | ## Sample 02 92 | ![](ExcelXML_sample02.png) 93 | 94 | ![](ExcelXML_sample02_excel.png) 95 | 96 | ## Sample 03 97 | ![](ExcelXML_sample03.png) 98 | 99 | ![](ExcelXML_sample03_excel.png) 100 | 101 | ## Sample 04 - No Grid control 102 | ![](ExcelXML_sample04.png) 103 | 104 | ![](ExcelXML_sample04_excel.png) 105 | -------------------------------------------------------------------------------- /ExcelXML.prg: -------------------------------------------------------------------------------- 1 | *-- This PRG file was extracted to a PRG file from the original VCX file by Matt Slay 2017-09-03. 2 | *-- This allows better updates of the source code by the VFP community on GitHib. 3 | *-- GitHub: https://github.com/VFPX/ExcelXML 4 | *--------------------------------------------------------------------------------------- 5 | *-- Change Log: 6 | *--------------------------------------------------------------------------------------- 7 | *- 2017-09-10: Ver 1.10 8 | *-- 1. Added new method: ConvertXmlToXlsx(tcFilename, tnFileFormat, tlOpenAfterExporting) 9 | *-- 2. Fixed bug in Bottom Border logic if cursor/grid only has 1 row of data. 10 | *-- 3. Added new properties for ColumnHeaderBackgroundColor and ColumnHeaderForeColor 11 | *-- 4. Added new property GridClass to use when creating a temporary form to create grid to host the cursor/alias during the export. 12 | *- 13 | *- 2017-09-03: Ver 1.09 14 | *-- Added Try/Catch to handle Dynamic properties that do evaluate properly. 15 | *- [By Matt Slay] 16 | *--------------------------------------------------------------------------------------- 17 | 18 | Define Class ExcelXml As Custom 19 | 20 | * Array with information about the structure of the table in a ; 21 | * specified work area, specified by a table alias, or in the currently ; 22 | * selected work area in an array and returns the number of fields in ; 23 | * the table. 24 | * Name of the table/cursor defined in the Grid or name of current ; 25 | * table/cursor opened. 26 | Alias = '' 27 | * Returns the number of columns included in the Excel file. 28 | ColumnCount = 0 29 | crlf = '' 30 | * Specifies the date format. 31 | DateFormat = '' 32 | * Inform the name of Excel file. If you don't inform the name with the ; 33 | * extension, the XML extension will be included. The default file name ; 34 | * is "Book1" 35 | File = '' 36 | * Inform the grid control object to convert a grid control in an Excel ; 37 | * XML file. 38 | GridObject = '' 39 | * .T. Includes the option Filter in all columns in the generated file. 40 | HasFilter = .F. 41 | Height = 16 42 | * .T. locks the header in the generated file. This option in Excel is ; 43 | * called by Freeze Top Row. 44 | LockHeader = .F. 45 | * .T. to open the file after saving it. 46 | OpenAfterSaving = .F. 47 | * Returns the number of rows included in the Excel file. 48 | RowCount = 0 49 | * Defines if the Excel file will have all the grid graphical attributes ; 50 | * transported. 51 | SetStyles = .T. 52 | * Excel sheet name. The default name is "Sheet1" 53 | SheetName = 'Sheet1' 54 | stylecodenumber = 0 55 | * Object that contain the information about this class. 56 | Version = '' 57 | Width = 70 58 | * XML encoding type used to set the code that defines special ; 59 | * characters. Default code is "iso-8859-1". 60 | xmlEncoding = 'iso-8859-1' 61 | cErrorMessage = "" 62 | * The grid class name to use when creating a temporary form to create grid to host the cursor 63 | * during the export. 64 | GridClass = "grid" 65 | * Colmn Header Background color. Can override grid header backcolor. Set to a string with Hex value, like "#CCCCCC" for light gray. 66 | ColumnHeaderBackgroundColor = .null. 67 | * Colmn Header ForegColor. Can override grid header forecolor. Set to a string with Hex value, like "#000000" for black. 68 | ColumnHeaderForeColor = .null. 69 | 70 | 71 | *|================================================================================ 72 | *| ExcelXml:: 73 | Procedure About 74 | 75 | Messagebox("ExcelXml " + This.Version.Number + " " + This.Version.Datetime + This.crlf + ; 76 | "Converts a Grid control into a Microsoft Excel XML file" + This.crlf + ; 77 | "" + This.crlf + ; 78 | "Created by " + This.Version.Author + This.crlf + ; 79 | This.Version.CountryAndCity + This.crlf + ; 80 | This.Version.url + This.crlf + ; 81 | This.Version.Email, 64, "About ExcelXml") 82 | Endproc 83 | 84 | 85 | *|================================================================================ 86 | *| ExcelXml:: 87 | Procedure AddNewStyle 88 | Lparameters plcType, plnRow, plnCol, ; 89 | plcAlignH, plcAlignV, plcFontName, plcFontFamily, ; 90 | plcFontSize, plcForeColor, plcFontBold, plcFontItalic, ; 91 | plcFontUnderline, plcFontStrikeThru, plcBackColor, plcPattern, ; 92 | plcFormat 93 | 94 | Local lcStyleCode, lcXmlStyle 95 | lcXmlStyle = "" 96 | 97 | *- Defini��o de bordas entre as linhas/colunas (c�lulas) 98 | lcXmlBorderStyle = "" 99 | lcTop = "0" 100 | lcBottom = "0" 101 | 102 | If This.GridObject.GridLines >= 1 And This.SetStyles 103 | lcGridLineWidth = Iif(plcType = "c", Alltrim(Str(Iif(This.GridObject.GridLineWidth >= 4, 3, This.GridObject.GridLineWidth))), "1") 104 | lcGridLineColor = Iif(plcType = "c", This.ColorToStrHexa(This.GridObject.GridLineColor), This.ColorToStrHexa(Rgb(100, 100, 100))) 105 | lcXmlBorderStyle = [ ] + This.crlf 106 | 107 | *- Linhas na horizontal 108 | If Inlist(This.GridObject.GridLines, 1, 3) 109 | lcXmlBorderStyle = lcXmlBorderStyle + [ ] + This.crlf 110 | lcXmlBorderStyle = lcXmlBorderStyle + [ ] + This.crlf 111 | EndIf 112 | 113 | *- Linhas na vertical 114 | If Inlist(This.GridObject.GridLines, 2, 3) 115 | If This.GridObject.GridLines = 2 116 | If plnRow = 1 &&- Se for a primeira linha 117 | lcTop = "1" 118 | lcXmlBorderStyle = lcXmlBorderStyle + [ ] + This.crlf 119 | Endif 120 | If plnRow = (This.RowCount - 1) &&- Se for a ultima linha 121 | lcBottom = "1" 122 | lcXmlBorderStyle = lcXmlBorderStyle + [ ] + This.crlf 123 | Endif 124 | Endif 125 | 126 | lcXmlBorderStyle = lcXmlBorderStyle + [ ] + This.crlf 127 | lcXmlBorderStyle = lcXmlBorderStyle + [ ] + This.crlf 128 | Endif 129 | 130 | lcXmlBorderStyle = lcXmlBorderStyle + [ ] + This.crlf 131 | Else 132 | lcXmlBorderStyle = [ ] + This.crlf 133 | Endif 134 | 135 | 136 | *- Adiciono no cursor caso n�o ache um registro com os mesmos dados 137 | If Not Seek(plcAlignH + plcAlignV + plcFontName + plcFontFamily + ; 138 | plcFontSize + plcForeColor + plcFontBold + plcFontItalic + ; 139 | plcFontUnderline + plcFontStrikeThru + plcBackColor + plcPattern + ; 140 | plcFormat + lcTop + lcBottom, ; 141 | "xxxStylesProperties", "idxStyle") 142 | 143 | This.stylecodenumber = This.stylecodenumber + 1 144 | lcStyleCode = Alltrim(Lower(plcType)) + Transform(This.stylecodenumber, "@L 99999") 145 | 146 | *- xml de estilo da celula 147 | lcXmlStyle = [ ] 155 | 156 | Insert Into xxxStylesProperties ; 157 | Values ( lcStyleCode, ; 158 | plcAlignH, ; 159 | plcAlignV, ; 160 | plcFontName, ; 161 | plcFontFamily, ; 162 | plcFontSize, ; 163 | plcForeColor, ; 164 | plcFontBold, ; 165 | plcFontItalic, ; 166 | plcFontUnderline, ; 167 | plcFontStrikeThru, ; 168 | plcBackColor, ; 169 | plcPattern, ; 170 | plcFormat, ; 171 | lcTop, ; 172 | lcBottom, ; 173 | lcXmlStyle ) 174 | Endif 175 | 176 | Insert Into xxxStylesRowCol ; 177 | Values ( Transform(plnRow, "@L 999999"), ; 178 | Transform(plnCol, "@L 999"), ; 179 | xxxStylesProperties.ssCode ) 180 | 181 | Return lcXmlStyle 182 | Endproc 183 | 184 | 185 | *|================================================================================ 186 | *| ExcelXml:: 187 | Procedure BuildColumnsStyles 188 | 189 | Local lcAlignH, lcAlignV, lcFontName, lcFontFamily, ; 190 | lcFontSize, lcForeColor, lcFontBold, lcFontItalic, ; 191 | lcFontUnderline, lcFontStrikeThru, lcBackColor, lcPattern, ; 192 | lcFormat, lcXmlBorderStyle, lcXmlStyles, lnRow, lnCol, lnRowFound 193 | 194 | This.stylecodenumber = 0 195 | lnRow = 0 196 | lnCol = 0 197 | lcXmlStyles = "" 198 | 199 | 200 | *- Verifico os estilos de todas as linhas/colunas do grid 201 | Select (This.Alias) 202 | Go Top 203 | Scan 204 | lnRow = lnRow + 1 205 | 206 | If Not This.SetStyles And lnRow >= 2 &&- N�o aplica os estilos ao grid. 207 | Exit 208 | Endif 209 | 210 | For lnCol = 1 To This.GridObject.ColumnCount 211 | loColumn = This.GetColumn(lnCol) 212 | If Not loColumn.Visible &&-Considero somente as colunas visiveis 213 | Loop 214 | Endif 215 | 216 | *- Formato dos dados da linha/coluna (c�lula) 217 | lcDataColumn = Evaluate(loColumn.ControlSource) 218 | loCurrentControl = This.GetCurrentControlObject(loColumn) 219 | lcFormat = "" 220 | 221 | If Not Isnull(loCurrentControl) 222 | Do Case 223 | Case Inlist(Vartype(lcDataColumn), "N", "Y") 224 | If Lower(loCurrentControl.BaseClass) $ "textbox//spinner" 225 | If Not Empty(loColumn.InputMask) 226 | lcInputMask = loColumn.InputMask 227 | If Occurs(".", lcInputMask) > 0 228 | lcFormat = "#,##0." + Replicate("0", Len(Subs(lcInputMask, Rat(".", lcInputMask) + 1))) 229 | Else 230 | lcFormat = "#,##0" 231 | Endif 232 | Else 233 | lnRowFound = Ascan(This._Fields, Iif("." $ loColumn.ControlSource, Substr(loColumn.ControlSource, At(".", loColumn.ControlSource) + 1), loColumn.ControlSource), -1, -1, 1, 15) 234 | If lnRowFound > 0 And This._Fields[lnRowFound, 4] > 0 235 | lcFormat = "#,##0." + Replicate("0", This._Fields[lnRowFound, 4]) 236 | Else 237 | lcFormat = "" 238 | Endif 239 | Endif 240 | Endif 241 | 242 | If Lower(loCurrentControl.BaseClass) $ "checkbox//optiongroup" 243 | lcFormat = "" 244 | Endif 245 | 246 | Case Vartype(lcDataColumn) = "D" 247 | lcFormat = This.DateFormat + ";@" 248 | 249 | Case Vartype(lcDataColumn) = "T" 250 | If Lower(loCurrentControl.BaseClass) = "textbox" 251 | lnHasSeconds = loCurrentControl.Seconds 252 | Else 253 | lnHasSeconds = 2 254 | Endif 255 | 256 | If lnHasSeconds = 0 257 | *- Data e hora sem segundos 258 | lcFormat = This.DateFormat + "\ h:mm" + Iif(Set("hours") = 12, " AM/PM", "") 259 | Else 260 | *- Data e hora com segundos 261 | lcFormat = This.DateFormat + "\ h:mm:ss" + Iif(Set("hours") = 12, " AM/PM", "") 262 | Endif 263 | 264 | Case Vartype(lcDataColumn) = "L" 265 | lcFormat = "True/False" 266 | 267 | Otherwise 268 | lcFormat = "" 269 | Endcase 270 | Endif 271 | 272 | lcFormat = Padr(lcFormat, Len(xxxStylesProperties.ssFormat)) 273 | 274 | *- Requisitos fixos para o estilo 275 | lcFontFamily = Padr("Swiss", Len(xxxStylesProperties.ssFontFamily)) 276 | lcPattern = Padr("Solid", Len(xxxStylesProperties.ssPattern)) 277 | 278 | *- Alinhamento Horizontal do texto da coluna/linha 279 | If Not Isnull(loCurrentControl) And Lower(loCurrentControl.BaseClass) = "combobox" 280 | lcAlignH = This.GetColumnAlign("H", loCurrentControl.Alignment, Vartype(lcDataColumn)) 281 | lcAlignV = This.GetColumnAlign("V", loCurrentControl.Alignment, Vartype(lcDataColumn)) 282 | Else 283 | lcAlignH = This.GetColumnAlign("H", loColumn.Alignment, Vartype(lcDataColumn)) 284 | lcAlignV = This.GetColumnAlign("V", loColumn.Alignment, Vartype(lcDataColumn)) 285 | Endif 286 | 287 | *- cor de fundo da coluna/linha 288 | If Not Empty(loColumn.DynamicBackColor) 289 | Try 290 | lcBackColor = This.ColorToStrHexa(Evaluate(loColumn.DynamicBackColor) ) 291 | Catch 292 | lcBackColor = This.ColorToStrHexa( loColumn.BackColor ) 293 | Endtry 294 | Else 295 | lcBackColor = This.ColorToStrHexa( loColumn.BackColor ) 296 | Endif 297 | 298 | 299 | *- cor da fonte da coluna/linha 300 | If Not Empty(loColumn.DynamicForeColor) 301 | Try 302 | lcForeColor = This.ColorToStrHexa( Evaluate(loColumn.DynamicForeColor) ) 303 | Catch 304 | lcForeColor = This.ColorToStrHexa( loColumn.ForeColor ) 305 | Endtry 306 | Else 307 | lcForeColor = This.ColorToStrHexa( loColumn.ForeColor ) 308 | Endif 309 | 310 | 311 | *- fonte usada na coluna/linha 312 | If Not Empty(loColumn.DynamicFontName) 313 | Try 314 | lcFontName = Evaluate(loColumn.DynamicFontName) 315 | Catch 316 | lcFontName = Padr(lcFontName, Len(xxxStylesProperties.ssFontName)) 317 | Endtry 318 | Else 319 | lcFontName = loColumn.FontName 320 | Endif 321 | lcFontName = Padr(lcFontName, Len(xxxStylesProperties.ssFontName)) 322 | 323 | 324 | *- tamanho da fonte da coluna/linha 325 | If Not Empty(loColumn.DynamicFontSize) 326 | Try 327 | lcFontSize = Transform(Evaluate(loColumn.DynamicFontSize), "@L 999") 328 | Catch 329 | lcFontSize = Transform(loColumn.FontSize, "@L 999") 330 | Endtry 331 | Else 332 | lcFontSize = Transform(loColumn.FontSize, "@L 999") 333 | Endif 334 | 335 | 336 | *- Fonte Italica da coluna/linha 337 | If Not Empty(loColumn.DynamicFontItalic) 338 | Try 339 | lcFontItalic = Iif(Evaluate(loColumn.DynamicFontItalic), "1", "0") 340 | Catch 341 | lcFontItalic = Iif(loColumn.FontItalic, "1", "0") 342 | Endtry 343 | Else 344 | lcFontItalic = Iif(loColumn.FontItalic, "1", "0") 345 | Endif 346 | 347 | 348 | *- Fonte Negrito da coluna/linha 349 | If Not Empty(loColumn.DynamicFontBold) 350 | Try 351 | lcFontBold = Iif(Evaluate(loColumn.DynamicFontBold), "1", "0") 352 | Catch 353 | lcFontBold = Iif(loColumn.FontBold, "1", "0") 354 | Endtry 355 | Else 356 | lcFontBold = Iif(loColumn.FontBold, "1", "0") 357 | Endif 358 | 359 | 360 | *- Fonte Underline da coluna/linha 361 | If Not Empty(loColumn.DynamicFontUnderline) 362 | Try 363 | lcFontUnderline = Iif(Evaluate(loColumn.DynamicFontUnderline), "Single", "") 364 | Catch 365 | lcFontUnderline = Iif(loColumn.FontUnderline, "Single", "") 366 | Endtry 367 | Else 368 | lcFontUnderline = Iif(loColumn.FontUnderline, "Single", "") 369 | Endif 370 | lcFontUnderline = Padr(lcFontUnderline, Len(xxxStylesProperties.ssFontUnderline)) 371 | 372 | 373 | *- Fonte Underline da coluna/linha 374 | If Not Empty(loColumn.DynamicFontStrikethru) 375 | Try 376 | lcFontStrikeThru = Iif(Evaluate(loColumn.DynamicFontStrikethru), "1", "0") 377 | Catch 378 | lcFontStrikeThru = Iif(loColumn.FontStrikethru, "1", "0") 379 | Endtry 380 | Else 381 | lcFontStrikeThru = Iif(loColumn.FontStrikethru, "1", "0") 382 | Endif 383 | lcFontStrikeThru = Padr(lcFontStrikeThru, Len(xxxStylesProperties.ssFontStrikeThru)) 384 | 385 | 386 | *- se o estilo j� existir "lcXmlStyle" retorna "" 387 | lcXmlStyle = This.AddNewStyle( "c", lnRow, lnCol, ; 388 | lcAlignH, lcAlignV, lcFontName, lcFontFamily, ; 389 | lcFontSize, lcForeColor, lcFontBold, lcFontItalic, ; 390 | lcFontUnderline, lcFontStrikeThru, lcBackColor, lcPattern, ; 391 | lcFormat ) 392 | 393 | If Not Empty(lcXmlStyle) 394 | lcXmlStyles = lcXmlStyles + This.crlf + lcXmlStyle 395 | Endif 396 | Endfor 397 | Endscan 398 | 399 | Return lcXmlStyles 400 | Endproc 401 | 402 | 403 | *|================================================================================ 404 | *| ExcelXml:: 405 | Procedure BuildColumnsWidth 406 | 407 | Local lcXmlColumnsWidth, lnCol, lnColumnWidth 408 | 409 | lcXmlColumnsWidth = This.crlf 410 | 411 | For lnCol = 1 To This.GridObject.ColumnCount 412 | loColumn = This.GetColumn(lnCol) 413 | If loColumn.Visible = .T. 414 | lnColumnWidth = Iif(loColumn.Width > 700, 700, loColumn.Width) &&- Avoiding error in Excel 415 | lcXmlColumnsWidth = lcXmlColumnsWidth + [ ] + This.crlf 416 | Endif 417 | Endfor 418 | 419 | Return lcXmlColumnsWidth 420 | 421 | Endproc 422 | 423 | 424 | *|================================================================================ 425 | *| ExcelXml:: 426 | Procedure BuildHeadersStyles 427 | 428 | Local loColumn, loColumnHeader, lnCol, lcXmlStyles, lcXmlStyle, ; 429 | lcBackColor, lcForeColor, lcFontName, lcFontSize, lcFontItalic, ; 430 | lcFontBold, lcFontUnderline, lcFontStrikeThru, lcFormat, ; 431 | lcFontFamily, lcPattern, lcAlignH, lcAlignV, lcCollate 432 | 433 | lcXmlStyle = "" 434 | lcXmlStyles = "" 435 | This.stylecodenumber = 0 436 | lcCollate = Set("Collate") 437 | 438 | Set Collate To "MACHINE" 439 | 440 | *- Crio cursor para armazenar todos os estilos encontrados 441 | Create Cursor xxxStylesProperties ( ssCode c(6), ; 442 | ssAlignH c(6), ; 443 | ssAlignV c(6), ; 444 | ssFontName c(40), ; 445 | ssFontFamily c(5), ; 446 | ssFontSize c(3), ; 447 | ssFontColor c(7), ; 448 | ssFontBold c(1), ; 449 | ssFontItalic c(1), ; 450 | ssFontUnderline c(6), ; 451 | ssFontStrikeThru c(1), ; 452 | ssBackColor c(7), ; 453 | ssPattern c(5), ; 454 | ssFormat c(40), ; 455 | ssTop c(1), ; 456 | ssBottom c(1), ; 457 | ssStyle m ) 458 | 459 | 460 | 461 | Select xxxStylesProperties 462 | Index On ssAlignH + ssAlignV + ssFontName + ; 463 | ssFontFamily + ssFontSize + ssFontColor + ; 464 | ssFontBold + ssFontItalic + ssFontUnderline + ssFontStrikeThru + ; 465 | ssBackColor + ssPattern + ssFormat + ssTop + ssBottom Tag idxStyle 466 | 467 | Index On ssCode Tag idxCode 468 | 469 | *- Crio cursor para gravar o estilo que sera usado pela linha/coluna (c�lula) 470 | Create Cursor xxxStylesRowCol ( ssRow c(6), ; 471 | ssCol c(3), ; 472 | ssCode c(6) ) 473 | 474 | Select xxxStylesRowCol 475 | Index On ssRow + ssCol Tag idxRowCol 476 | 477 | Set Collate To lcCollate 478 | 479 | 480 | *- Verifico os estilos dos headers de cada coluna 481 | If This.GridObject.HeaderHeight > 0 482 | For lnCol = 1 To This.GridObject.ColumnCount 483 | loColumn = This.GetColumn(lnCol) 484 | loColumnHeader = This.GetColumnHeader(loColumn) 485 | 486 | If IsNull(This.ColumnHeaderBackgroundColor) 487 | lcBackColor = This.ColorToStrHexa( Iif(This.SetStyles, loColumnHeader.BackColor, Rgb(255, 255, 255)) ) 488 | Else 489 | lcBackColor = This.ColumnHeaderBackgroundColor 490 | EndIf 491 | 492 | If IsNull(This.ColumnHeaderForeColor) 493 | lcForeColor = This.ColorToStrHexa( Iif(This.SetStyles, loColumnHeader.ForeColor, Rgb(0, 0, 0)) ) 494 | Else 495 | lcForeColor = This.ColumnHeaderForeColor 496 | EndIf 497 | 498 | lcFontName = Padr(loColumnHeader.FontName, Len(xxxStylesProperties.ssFontName)) 499 | lcFontSize = Transform(loColumnHeader.FontSize, "@L 999") 500 | lcFontItalic = Iif(loColumnHeader.FontItalic, "1", "0") 501 | lcFontBold = Iif(loColumnHeader.FontBold Or This.SetStyles = .F., "1", "0") 502 | lcFontUnderline = Padr(Iif(loColumnHeader.FontUnderline Or This.SetStyles = .F., "Single", ""), Len(xxxStylesProperties.ssFontUnderline)) 503 | lcFontStrikeThru = Iif(loColumnHeader.FontStrikethru, "1", "0") 504 | lcFormat = Padr("", Len(xxxStylesProperties.ssFormat)) 505 | lcFontFamily = Padr("Swiss", Len(xxxStylesProperties.ssFontFamily)) 506 | lcPattern = Padr("Solid", Len(xxxStylesProperties.ssPattern)) 507 | lcAlignH = Iif(This.SetStyles, This.GetColumnAlign("H", loColumnHeader.Alignment), "Left") 508 | lcAlignV = Iif(This.SetStyles, This.GetColumnAlign("V", loColumnHeader.Alignment), "Center") 509 | 510 | *- se o estilo j� existir "lcXmlStyle" retorna "" 511 | lcXmlStyle = This.addnewstyle( "h", 0, lnCol, ; 512 | lcAlignH, lcAlignV, lcFontName, lcFontFamily, ; 513 | lcFontSize, lcForeColor, lcFontBold, lcFontItalic, ; 514 | lcFontUnderline, lcFontStrikeThru, lcBackColor, lcPattern, ; 515 | lcFormat ) 516 | 517 | If Not Empty(lcXmlStyle) 518 | lcXmlStyles = lcXmlStyles + This.crlf + lcXmlStyle 519 | Endif 520 | Endfor 521 | Endif 522 | 523 | Return lcXmlStyles 524 | 525 | Endproc 526 | 527 | 528 | *|================================================================================ 529 | *| ExcelXml:: 530 | Procedure BuildRows 531 | Local lcXmlRows, lcDataType, lcDataColumn, lcAuxDataColumn, lnRow, lnCol, loColumn, loColumnHeader, loCurrentControl, ; 532 | lnPercent, lnCountRowSource, lcCountOption, laArrayTmp, lcComboOption, lcToolTipText, lnBytes, llHasDecimals, ; 533 | lnSetDecimals, lnRowFound, lnYear 534 | 535 | lcXmlRows = This.crlf 536 | lnRow = 0 537 | lnCol = 0 538 | lnBytes = 0 539 | lnSetDecimals = Set("Decimals") 540 | 541 | *- Adiciono a linha do Header no arquivo excel 542 | If This.GridObject.HeaderHeight > 0 543 | lcXmlRows = lcXmlRows + [ ] + This.crlf 544 | 545 | For lnCol = 1 To This.GridObject.ColumnCount 546 | loColumn = This.GetColumn(lnCol) 547 | loColumnHeader = This.GetColumnHeader(loColumn) 548 | 549 | If loColumn.Visible = .T. 550 | *- caso tenha tooltiptext 551 | lcToolTipText = "" 552 | If Not Empty(loColumnHeader.ToolTipText) 553 | lcToolTipText = [] + ; 554 | [] + ; 555 | [] + Alltrim(loColumnHeader.ToolTipText) + [] + ; 556 | [] + ; 557 | [] 558 | Endif 559 | 560 | *- linha do header 561 | lcXmlRows = lcXmlRows + [ ] + loColumnHeader.Caption + [] + lcToolTipText + [] + This.crlf 562 | Endif 563 | Endfor 564 | 565 | lcXmlRows = lcXmlRows + [ ] + This.crlf 566 | Endif 567 | 568 | lcXmlRows = lcXmlRows + This.crlf 569 | 570 | *- Adiciono a linha do Registro no arquivo excel 571 | Select (This.Alias) 572 | Go Top 573 | 574 | Scan 575 | lnRow = lnRow + 1 576 | lcXmlRows = lcXmlRows + [ ] + This.crlf 577 | 578 | *- percentual processado 579 | lnPercent = Int((lnRow / (This.RowCount - (Iif(This.GridObject.HeaderHeight > 0, 1, 0))) ) * 100) 580 | This.Progress(lnPercent) 581 | 582 | *- fa�o a varredura em todas as colunas 583 | For lnCol = 1 To This.GridObject.ColumnCount 584 | loColumn = This.GetColumn(lnCol) 585 | If Not loColumn.Visible 586 | Loop 587 | Endif 588 | 589 | *- Verifico o tipo de dado da coluna 590 | lcDataColumn = Evaluate(loColumn.ControlSource) 591 | loCurrentControl = This.GetCurrentControlObject(loColumn) 592 | 593 | *- se n�o tem objeto de controle na linha da coluna n�o levo a informa��o da tabela ao excel 594 | If Isnull(loCurrentControl) 595 | lcDataType = "String" 596 | lcDataColumn = "" 597 | Else 598 | Do Case 599 | Case Vartype(lcDataColumn) $ "N//Y" 600 | lcDataType = "Number" 601 | 602 | *- Se o currentcontrol da coluna for um combobox mostro o seu conteudo ao inves da posi��o numerica 603 | If Lower(loCurrentControl.BaseClass) = "combobox" 604 | Try 605 | Do Case 606 | *- Mostro o texto do value 607 | Case loCurrentControl.RowSourceType = 1 608 | lcDataType = "String" 609 | 610 | If Not Empty(loCurrentControl.RowSource) 611 | lcAuxDataColumn = Alltrim(loCurrentControl.RowSource) 612 | lcAuxDataColumn = Strtran(Strtran(Strtran(lcAuxDataColumn, " ,", ","), ", ", ","), " , ", ",") 613 | lcCountOption = Occurs(",", lcAuxDataColumn) + 1 614 | 615 | Dimension laArrayTmp[lcCountOption] 616 | For lnCountRowSource = 1 To lcCountOption 617 | lcComboOption = Substr(lcAuxDataColumn, 1, Iif(lnCountRowSource < lcCountOption, At(",", lcAuxDataColumn) - 1, Len(lcAuxDataColumn)) ) 618 | lcAuxDataColumn = Strtran(lcAuxDataColumn, lcComboOption + Iif(lcCountOption >= 2, ",", ""), "") 619 | laArrayTmp[lnCountRowSource] = lcComboOption 620 | Endfor 621 | 622 | lcDataColumn = Evaluate("laArrayTmp[" + Alltrim(Str(lcDataColumn)) + "]") 623 | Endif 624 | 625 | *- Mostro o texto do array do combo 626 | Case loCurrentControl.RowSourceType = 5 627 | lcDataType = "String" 628 | 629 | *- Se for um array objeto ex: thisform.ArrayName ou MyObj.ArrayName 630 | If Occurs(".", loCurrentControl.RowSource) > 0 631 | lcObjArrayName = Substr(loCurrentControl.RowSource, 1, Rat(".", loCurrentControl.RowSource) - 1) 632 | 633 | *- Se for um array objeto publico 634 | If Type(lcObjArrayName) = "O" 635 | lcAuxDataColumn = loCurrentControl.RowSource + "[" + Alltrim(Str(lcDataColumn)) + "]" 636 | Else 637 | lcArrayName = Substr(loCurrentControl.RowSource, Rat(".", loCurrentControl.RowSource) + 1) 638 | lnCountObjectHierarchy = Occurs(".", Sys(1272, This.GridObject)) 639 | lcAuxDataColumn = "This.GridObject" + Replicate(".Parent", lnCountObjectHierarchy) + "." + lcArrayName + "[" + Alltrim(Str(lcDataColumn)) + "]" 640 | Endif 641 | 642 | *- Array comum 643 | Else 644 | lcAuxDataColumn = loCurrentControl.RowSource + "[" + Alltrim(Str(lcDataColumn)) + "]" 645 | Endif 646 | 647 | lcDataColumn = Evaluate(lcAuxDataColumn) 648 | 649 | 650 | *- Qualquer outro mostro o conteudo do campo e n�o o conteudo do array 651 | Otherwise 652 | lcDataColumn = lcDataColumn 653 | Endcase 654 | 655 | Catch To loError 656 | Endtry 657 | 658 | If Vartype(loError) = "O" 659 | Messagebox( "Combo array '" + loCurrentControl.RowSource + "' in column '" + loColumn.Name + "' not is valid", 48) 660 | Select (This.Alias) 661 | Go Top 662 | Return .F. 663 | Endif 664 | Else 665 | 666 | lnRowFound = Ascan(This._Fields, Iif("." $ loColumn.ControlSource, Substr(loColumn.ControlSource, At(".", loColumn.ControlSource) + 1), loColumn.ControlSource), -1, -1, 1, 15) 667 | If lnRowFound > 0 And This._Fields[lnRowFound, 4] > 0 668 | llHasDecimals = .T. 669 | Set Decimals To This._Fields[lnRowFound, 4] 670 | Else 671 | llHasDecimals = .F. 672 | Endif 673 | 674 | Endif 675 | 676 | Case Vartype(lcDataColumn) = "D" 677 | lcDataType = "DateTime" 678 | If Not Empty(Nvl(lcDataColumn, "")) 679 | lnYear = Iif(Year(lcDataColumn) < 1900, 1900, Year(lcDataColumn)) 680 | lcAuxDataColumn = Str(lnYear, 4) + "-" + Transform(Month(lcDataColumn), "@L 99") + "-" + Transform(Day(lcDataColumn), "@L 99") + "T00:00:00.000" 681 | lcDataColumn = lcAuxDataColumn 682 | Else 683 | lcDataType = "String" 684 | lcDataColumn = "" 685 | Endif 686 | 687 | Case Vartype(lcDataColumn) = "T" 688 | lcDataType = "DateTime" 689 | If Not Empty(Nvl(lcDataColumn, "")) 690 | lnYear = Iif(Year(lcDataColumn) < 1900, 1900, Year(lcDataColumn)) 691 | lcAuxDataColumn = Str(lnYear, 4) + "-" + Transform(Month(lcDataColumn), "@L 99") + "-" + Transform(Day(lcDataColumn), "@L 99") + ; 692 | "T" + Transform(Hour(lcDataColumn), "@L 99") + ":" + Transform(Minute(lcDataColumn), "@L 99") + ":" + Transform(Sec(lcDataColumn), "@L 99") + ".000" 693 | lcDataColumn = lcAuxDataColumn 694 | Else 695 | lcDataType = "String" 696 | lcDataColumn = "" 697 | Endif 698 | 699 | Case Vartype(lcDataColumn) = "L" 700 | lcDataType = "Number" 701 | lcDataColumn = Iif(lcDataColumn, 1, 0) 702 | 703 | Otherwise 704 | lcDataType = "String" 705 | If Isnull(lcDataColumn) 706 | lcDataColumn = "" 707 | Endif 708 | Endcase 709 | Endif 710 | 711 | *- removing invalid characters 712 | If lcDataType = "String" And ("<" $ lcDataColumn Or ">" $ lcDataColumn) 713 | lcDataColumn = Strtran(Strtran(lcDataColumn, "<", "["), ">", "]") 714 | Endif 715 | 716 | *- incluo a linha de dados 717 | lcXmlRows = lcXmlRows + [ ] + Alltrim(Transform(lcDataColumn, "")) + [] + This.crlf 718 | 719 | *- devolvo o atributo original 720 | If llHasDecimals 721 | Set Decimals To lnSetDecimals 722 | Endif 723 | Endfor 724 | 725 | lcXmlRows = lcXmlRows + [ ] + This.crlf 726 | lnBytes = lnBytes + Strtofile( lcXmlRows + This.crlf, This.File, 1) 727 | lcXmlRows = "" 728 | 729 | Endscan 730 | 731 | Return lnBytes 732 | Endproc 733 | 734 | 735 | *|================================================================================ 736 | *| ExcelXml:: 737 | Procedure ColorToStrHexa(plnColor) 738 | 739 | Local lnDecimalColor 740 | 741 | lnDecimalColor = Substr(Transform(plnColor, '@0'), 5) 742 | Return "#" + Right(lnDecimalColor, 2) + Substr(lnDecimalColor, 3, 2) + Left(lnDecimalColor, 2) 743 | 744 | Endproc 745 | 746 | 747 | *|================================================================================ 748 | *| ExcelXml:: 749 | Procedure GetColumn(plcColumnNumber) 750 | 751 | Local lnCol 752 | 753 | For lnCol = 1 To This.GridObject.ColumnCount 754 | If This.GridObject.Columns(lnCol).ColumnOrder = plcColumnNumber 755 | Return This.GridObject.Columns(lnCol) 756 | Endif 757 | EndFor 758 | 759 | Endproc 760 | 761 | 762 | *|================================================================================ 763 | *| ExcelXml:: 764 | Procedure GetColumnAlign(plcWhat, plnAlignment, plcVartype) 765 | 766 | Local lcAlignment, lcAlignH, lcAlignV 767 | 768 | plcVartype = Evl(plcVartype, "") 769 | lcAlignment = Alltrim(Str(plnAlignment)) 770 | 771 | *- Alinhamento Horizontal do texto da coluna/linha 772 | If plcWhat = "H" 773 | Do Case 774 | Case lcAlignment $ "0//4//7" 775 | lcAlignH = "Left" 776 | Case lcAlignment $ "1//5//8" 777 | lcAlignH = "Right" 778 | Case lcAlignment $ "2//6//9" 779 | lcAlignH = "Center" 780 | Otherwise 781 | lcAlignH = Iif(plcVartype $ "N//Y", "Right", "Left") 782 | Endcase 783 | 784 | lcAlignH = Padr(lcAlignH, Len(xxxStylesProperties.ssAlignH)) 785 | Return lcAlignH 786 | Endif 787 | 788 | *- Alinhamento vertical do texto da coluna/linha 789 | If plcWhat = "V" 790 | Do Case 791 | Case lcAlignment $ "4//5//6" 792 | lcAlignV = "Top" 793 | Case lcAlignment $ "7//8//9" 794 | lcAlignV = "Bottom" 795 | Case lcAlignment $ "0//1//2" 796 | lcAlignV = "Center" 797 | Otherwise 798 | lcAlignV = "Center" 799 | Endcase 800 | 801 | lcAlignV = Padr(lcAlignV, Len(xxxStylesProperties.ssAlignV)) 802 | Return lcAlignV 803 | EndIf 804 | 805 | Endproc 806 | 807 | 808 | *|================================================================================ 809 | *| ExcelXml:: 810 | Procedure GetColumnHeader(ploColumn) 811 | 812 | Local loReturn, lnX 813 | loReturn = "" 814 | 815 | If ploColumn.ControlCount > 0 816 | For lnX = 1 To ploColumn.ControlCount 817 | If Lower(ploColumn.Controls(lnX).BaseClass) = "header" 818 | loReturn = ploColumn.Controls(lnX) 819 | Exit 820 | Endif 821 | Endfor 822 | Endif 823 | 824 | Return loReturn 825 | 826 | Endproc 827 | 828 | 829 | *|================================================================================ 830 | *| ExcelXml:: 831 | Procedure GetCurrentControlObject(ploGridColumn) 832 | 833 | Local lcCurrentControl 834 | 835 | If Not Empty(ploGridColumn.DynamicCurrentControl) 836 | Try 837 | lcCurrentControl = Evaluate(ploGridColumn.DynamicCurrentControl) 838 | Catch 839 | lcCurrentControl = ploGridColumn.CurrentControl 840 | Endtry 841 | Else 842 | lcCurrentControl = ploGridColumn.CurrentControl 843 | Endif 844 | 845 | If Not Empty(lcCurrentControl) 846 | Return Evaluate("ploGridColumn." + lcCurrentControl) 847 | Else 848 | Return Null 849 | EndIf 850 | 851 | Endproc 852 | 853 | 854 | *|================================================================================ 855 | *| ExcelXml:: 856 | Procedure HasColumnVisible 857 | 858 | Local lnCol, llReturn 859 | llReturn = .F. 860 | 861 | For lnCol = 1 To This.GridObject.ColumnCount 862 | If This.GridObject.Columns(lnCol).Visible 863 | llReturn = .T. 864 | Exit 865 | Endif 866 | Endfor 867 | 868 | Return llReturn 869 | 870 | Endproc 871 | 872 | 873 | *|================================================================================ 874 | *| ExcelXml:: 875 | */---------------------------------------------------------------------------------------------------/* 876 | */ Descripton..: - Classe para converter o grid do vfp em um arquivo xml para o Excel. /* 877 | */ - A grande vantagem na utiliza��o � que N�O NECESSITA DO EXCEL INSTALADO /* 878 | */ pois em nenhum momento o Excel � instanciado para automa��o. /* 879 | */ Apesar de ser um arquivo xml, se encontra no padr�o Microsoft onde � reconhecido /* 880 | */ pelo Excel como "Planilha XML 2003 (*.xml)". Dessa forma fica restrito o uso /* 881 | */ para Excel 2003 ou superior. /* 882 | */ /* 883 | */ - Se o Excel estiver instalado o icone do arquivo gerado ser� reconhecido /* 884 | */ pelo Excel e abrindo o arquivo ser� reconhecido como se fosse um XLS ou XLSX, /* 885 | */ ou seja, tudo ser� transparente para o Excel. /* 886 | */ /* 887 | */ - Praticamente todos os recursos visuais do grid, headers, colunas e linhas /* 888 | */ s�o tratados na exporta��o. Segue abaixo as propriedades reconhecidas: /* 889 | */ /* 890 | */ Header Properties /* 891 | */ --------------------------------- /* 892 | */ ToolTipText / HeaderHeight / Alignment / FontBold / FontItalic / FontUnderline / /* 893 | */ FontStrikeThru / FontName / FontSize / ForeColor / BackColor / Caption / /* 894 | */ /* 895 | */ Columns Properties /* 896 | */ --------------------------------- /* 897 | */ ControlSource / BaseClass / InputMask / Seconds / RowHeight / Alignment / /* 898 | */ FontBold / FontItalic / FontUnderline / FontStrikeThru / FontName / FontSize / /* 899 | */ ForeColor / FontBackColor / CurrentControl / DynamicFontBold / DynamicFontItalic /* 900 | */ DynamicFontUnderline / DynamicFontStrikeThru / DynamicCurrentControl / /* 901 | */ DynamicFontName / DynamicFontSize / DynamicForeColor / DynamicBackColor / /* 902 | */ ColumnCount / ColumnOrder / Width / Visible / Combobox.Alignment / /* 903 | */ Combobox.RowSource / Combobox.RowSourceType /* 904 | */ /* 905 | */ Environment /* 906 | */ --------------------------------- /* 907 | */ set date / set century / set hours /* 908 | */ /* 909 | */ 910 | */ Goals 911 | */ ------ 912 | */ a) Possibilidade de gerar planilhas com mais de 65,535 linhas superando 913 | */ a limita�ao nativa do VFP 914 | */ b) Converte um grid em planilha Excel assumindo 99% do visual do grid 915 | */ c) Easy to implement and it is not necessary to change your code 916 | */ d) Compativel com Excel 2003 ou superior 917 | */ e) Pode ser aberto pelo OpenOffice reduzindo erros de convers�o 918 | */ f) Ao abrir o arquivo pelo Excel � possivel salvar em outros formatos 919 | */ g) Nao precisa ter o Excel instalado 920 | */ 921 | */ /* 922 | */ Original Author......: Rodrigo Bruscain /* 923 | */ Original Date........: 25/05/2013 (Original) /* 924 | */ Country.....: Brazil - S�o Paulo - SP /* 925 | */---------------------------------------------------------------------------------------------------/* 926 | Procedure Init 927 | 928 | This.crlf = Chr(13) + Chr(10) 929 | 930 | Local lcDateFormat, lcCentury 931 | 932 | AddProperty(This, "_Fields[1]") 933 | Dimension This._Fields[1,18] 934 | 935 | lcDateFormat = Set("Date") 936 | lcCentury = Iif(Set("century") = "ON", "yyyy", "yy") 937 | 938 | Do Case 939 | Case Inlist(lcDateFormat, "AMERICAN", "MDY") && month/day/year 940 | This.DateFormat = "mm/dd/" + lcCentury 941 | 942 | Case lcDateFormat = "ANSI" && year.month.day 943 | This.DateFormat = lcCentury + ".mm.dd" 944 | 945 | Case Inlist(lcDateFormat, "BRITISH", "DMY", "FRENCH") && day/month/year 946 | This.DateFormat = "dd/mm/" + lcCentury 947 | 948 | Case lcDateFormat = "GERMAN" && day.month.year 949 | This.DateFormat = "dd.mm." + lcCentury 950 | 951 | Case lcDateFormat = "ITALIAN" && day-month-year 952 | This.DateFormat = "dd-mm-" + lcCentury 953 | 954 | Case Inlist(lcDateFormat, "JAPAN", "YMD") && year/month/day 955 | This.DateFormat = lcCentury + "/mm/dd" 956 | 957 | Case lcDateFormat = "USA" && month-day-year 958 | This.DateFormat = "mm-dd-" + lcCentury 959 | 960 | Otherwise 961 | This.DateFormat = "dd/mm/" + lcCentury 962 | Endcase 963 | 964 | *- version object 965 | This.Version = Createobject("empty") 966 | AddProperty(This.Version, "Version", "1.10") 967 | AddProperty(This.Version, "DateTime", "Sep.10.2017 3:59:41 AM") 968 | AddProperty(This.Version, "Author", "Rodrigo Duarte Bruscain") 969 | AddProperty(This.Version, "CountryAndCity", "kitchener ON - Canada") 970 | AddProperty(This.Version, "Url", "https://github.com/ExcelXml") 971 | AddProperty(This.Version, "Email", "bruscain@hotmail.com") 972 | AddProperty(This.Version, "Email2", "mattslay@jordanmachine.com") 973 | 974 | Endproc 975 | 976 | 977 | *|================================================================================ 978 | *| ExcelXml:: 979 | Procedure Progress(plnPercent) 980 | 981 | *-- Add any code here that you want to execute as processing scans over each row... 982 | 983 | Endproc 984 | 985 | 986 | *|================================================================================ 987 | *| ExcelXml:: 988 | Procedure Save(plcFile) 989 | 990 | Local lcCreatedDate, lnCol, lcSetPoint, loForm, lcAlias, lnRecNo, ; 991 | lcXmlStart, lcXmlDocumentProperties, lcXmlExcelWorkbook, lcStringStyles, ; 992 | lcXmlAllStyles, lcXmlFreezePanes, lcStringFilter, lcStringColumnWidth, ; 993 | lcXmlWorksheet_part1, lcXmlWorksheet_part2, lnBytes, loError 994 | 995 | plcFile = Evl(plcFile, "Book1") 996 | This.File = Evl(This.File, plcFile) 997 | This.File = This.File + Iif(Empty(Justext(This.File)), ".XML", "") 998 | 999 | If Empty(Alias()) 1000 | Messagebox("No table is open in the current work area. ", 48) 1001 | Return .F. 1002 | Endif 1003 | 1004 | *- crio um grid virtual caso a nao exista um grid para conversao, 1005 | *- ou seja, estou convertendo somente a tabela 1006 | If VarType(This.GridObject) != "O" 1007 | loForm = CreateObject("form") 1008 | loForm.AddObject("grid1", This.GridClass) 1009 | loForm.Grid1.RecordSource = Alias() 1010 | loForm.Grid1.Visible = .T. 1011 | loForm.Refresh() 1012 | This.GridObject = loForm.Grid1 1013 | This.SetStyles = .F. 1014 | Endif 1015 | 1016 | *- environment 1017 | If This.GridObject.RecordSourceType = 1 1018 | This.Alias = This.GridObject.RecordSource 1019 | Else 1020 | This.Alias = Alias() 1021 | Endif 1022 | 1023 | lnRecNo = Recno() 1024 | Afields(This._Fields, This.Alias) 1025 | 1026 | 1027 | *- Data da cria��o do arquivo excel 1028 | lcCreatedDate = Str(Year(Date()), 4) + "-" + Transform(Month(Date()), "@L 99") + "-" + Transform(Day(Date()), "@L 99") + "T" + Time() + "Z" 1029 | 1030 | *- Numero de colunas v�lidas para o excel 1031 | This.ColumnCount = 0 1032 | For lnCol = 1 To This.GridObject.ColumnCount 1033 | If This.GridObject.Columns(lnCol).Visible = .T. 1034 | This.ColumnCount = This.ColumnCount + 1 1035 | Endif 1036 | Endfor 1037 | 1038 | *- Numero de linhas dispon�veis para o excel 1039 | This.RowCount = 0 1040 | Select (This.Alias) 1041 | Count To This.RowCount 1042 | Go Top 1043 | 1044 | If This.GridObject.HeaderHeight > 0 1045 | This.RowCount = This.RowCount + 1 1046 | Endif 1047 | 1048 | *- verifico se tudo esta ok para prosseguir 1049 | If Isnull(This.GridObject) Or This.GridObject.ColumnCount <= 0 And This.hascolumnvisible() 1050 | Return .F. 1051 | Endif 1052 | 1053 | *- No Excel casas decimais obrigat�riamente trabalham com ponto "." 1054 | lcSetPoint = Set("Point") 1055 | Set Point To "." 1056 | 1057 | *- Inicio tratamento dos dados 1058 | Text To lcXmlStart Textmerge Pretext 2 Noshow 1059 | >"?> 1060 | 1061 | 1066 | ENDTEXT 1067 | 1068 | Text To lcXmlDocumentProperties Textmerge Pretext 2 Noshow 1069 | 1070 | <> 1071 | <> 1072 | <> 1073 | <> 1074 | 12.00 1075 | 1076 | ENDTEXT 1077 | 1078 | Text To lcXmlExcelWorkbook Textmerge Pretext 2 Noshow 1079 | 1080 | 8130 1081 | 15135 1082 | 120 1083 | 45 1084 | False 1085 | False 1086 | 1087 | ENDTEXT 1088 | 1089 | 1090 | *- Crio os estilos de cores/fontes/formato/etc das colunas 1091 | *- Depois junto com o estilo padr�o todos os estilos encontrados 1092 | *- Estilos s�o todas as format�es da c�lulas combinadas onde um estilo pode ser usado 1093 | *- por v�rias c�luas ou por uma �nica c�lula. 1094 | lcStringStyles = "" 1095 | lcStringStyles = This.BuildHeadersStyles() &&- Estilos do header 1096 | lcStringStyles = lcStringStyles + This.buildcolumnsstyles() &&- Estilos das linhas/colunas 1097 | 1098 | Text To lcXmlAllStyles Textmerge Pretext 2 Noshow 1099 | 1100 | 1108 | <> 1109 | 1110 | ENDTEXT 1111 | 1112 | 1113 | *- Congelando paineis na horizontal e vertical 1114 | Do Case 1115 | *- Congelo a linha do header 1116 | Case This.GridObject.LockColumns = 0 And (This.GridObject.HeaderHeight > 0 And This.LockHeader) 1117 | Text To lcXmlFreezePanes Textmerge Pretext 2 Noshow 1118 | 1119 | 1120 | 1 1121 | 1 1122 | 2 1123 | 1124 | 1125 | 3 1126 | 1127 | 1128 | 2 1129 | 1130 | 1131 | ENDTEXT 1132 | 1133 | *- congelo a linha do header e a coluna definida 1134 | Case This.GridObject.LockColumns > 0 And (This.GridObject.HeaderHeight > 0 And This.LockHeader) 1135 | Text To lcXmlFreezePanes Textmerge Pretext 2 Noshow 1136 | 1137 | 1138 | 1 1139 | 1 1140 | <> 1141 | <> 1142 | 0 1143 | 1144 | 1145 | 3 1146 | 1147 | 1148 | 1 1149 | 1150 | 1151 | 2 1152 | 1153 | 1154 | 0 1155 | 1156 | 1157 | ENDTEXT 1158 | 1159 | *- congelo somente a coluna definida 1160 | Case This.GridObject.LockColumns > 0 And (This.GridObject.HeaderHeight = 0 Or Not This.LockHeader) 1161 | Text To lcXmlFreezePanes Textmerge Pretext 2 Noshow 1162 | 1163 | 1164 | 2 1165 | 2 1166 | 1 1167 | 1168 | 1169 | 3 1170 | 1171 | 1172 | 1 1173 | 1174 | 1175 | ENDTEXT 1176 | 1177 | Otherwise 1178 | lcXmlFreezePanes = "" 1179 | Endcase 1180 | 1181 | 1182 | *- filtros na colunas 1183 | lcStringFilter = "" 1184 | If This.HasFilter And This.GridObject.HeaderHeight > 0 1185 | Text To lcStringFilter Textmerge Pretext 2 Noshow 1186 | 1188 | 1189 | ENDTEXT 1190 | Endif 1191 | 1192 | 1193 | *- tratamento do nome da planilha 1194 | This.SheetName = Chrtran(Alltrim(Substr(This.SheetName, 1, 31)), ':?][*/\', '') 1195 | This.SheetName = Iif(Empty(This.SheetName), "Sheet1", This.SheetName) 1196 | 1197 | *- Monto a tabela 1198 | lcStringColumnWidth = This.buildcolumnswidth() 1199 | 1200 | Text To lcXmlWorksheet_part1 Textmerge Pretext 2 Noshow 1201 | 1202 | 1204 | <> 1205 | ENDTEXT 1206 | 1207 | Text To lcXmlWorksheet_part2 Textmerge Pretext 2 Noshow 1208 |
1209 | 1210 | 1211 |
1212 |