1290 lines
49 KiB
Plaintext
1290 lines
49 KiB
Plaintext
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
|
|
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
*< FOXBIN2PRG: Version="1.21" SourceFile="excelxml.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
|
|
*
|
|
*
|
|
DEFINE CLASS excelxml AS custom
|
|
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: about && About ExcelXML class
|
|
*m: addnewstyle && Cria o estilo para o excel caso ainda não exista um igual e retorna o a string xml do estilo criado.
|
|
*m: buildcolumnsstyles && Cria os estilos para uso das colunas e linhas. Ou seja, cada celula do grid é analizada para compor o seu estilo.
|
|
*m: buildcolumnswidth && Cria propriedades com as definições de cada coluna
|
|
*m: buildheadersstyles && Cria os estilos para uso do cabeçalho
|
|
*m: buildrows && Prepara o conteudo da tabela baseado nos estilos encontrados.
|
|
*m: colortostrhexa && Converto a cor do vfp para hexadecimal
|
|
*m: getcolumn && Retorna o objeto da coluna conforme sua ordem de apresentação no grid
|
|
*m: getcolumnalign && Retorna o alinhamento de um objeto para ser usado na linha/coluna (célula) do Excel
|
|
*m: getcolumnheader && Retorna o nome do header da coluna indicada
|
|
*m: getcurrentcontrolobject && Retorna o objeto corrente dentro da linha/coluna
|
|
*m: hascolumnvisible && Retorna o numero de colunas visiveis no grid
|
|
*m: progress && Method used to show the percentage processed.
|
|
*m: save && Creates the Excel XML file.
|
|
*m: seekstyle && Busco o estilo que será usado na Coluna/Linha (célula)
|
|
*p: alias && Name of the table/cursor defined in the Grid or name of current table/cursor opened.
|
|
*p: columncount && Returns the number of columns included in the Excel file.
|
|
*p: crlf
|
|
*p: dateformat && Specifies the date format.
|
|
*p: 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"
|
|
*p: gridobject && Inform the grid control object to convert a grid control in an Excel XML file.
|
|
*p: hasfilter && .T. Includes the option Filter in all columns in the generated file.
|
|
*p: lockheader && .T. locks the header in the generated file. This option in Excel is called by Freeze Top Row.
|
|
*p: openaftersaving && .T. to open the file after saving it.
|
|
*p: rowcount && Returns the number of rows included in the Excel file.
|
|
*p: setstyles && Defines if the Excel file will have all the grid graphical attributes transported.
|
|
*p: sheetname && Excel sheet name. The default name is "Sheet1"
|
|
*p: stylecodenumber
|
|
*p: version && Object that contain the information about this class.
|
|
*p: xmlencoding && XML encoding type used to set the code that defines special characters. Default code is "iso-8859-1".
|
|
*a: afields[1,18] && Array with information about the structure of the table in a specified work area, specified by a table alias, or in the currently selected work area in an array and returns the number of fields in the table.
|
|
*p: _memberdata && XML Metadata for customizable properties
|
|
*</DefinedPropArrayMethod>
|
|
|
|
HIDDEN afields,crlf,dateformat,stylecodenumber
|
|
PROTECTED alias
|
|
*<PropValue>
|
|
alias =
|
|
columncount = 0
|
|
crlf =
|
|
dateformat =
|
|
file =
|
|
gridobject =
|
|
hasfilter = .F.
|
|
Height = 16
|
|
lockheader = .F.
|
|
Name = "excelxml"
|
|
openaftersaving = .F.
|
|
rowcount = 0
|
|
setstyles = .T.
|
|
sheetname = Sheet1
|
|
stylecodenumber = 0
|
|
version =
|
|
Width = 70
|
|
xmlencoding = iso-8859-1
|
|
_memberdata = <VFPData>
|
|
<memberdata name="hasfilter" display="HasFilter" type="property"/>
|
|
<memberdata name="file" display="File" type="property"/>
|
|
<memberdata name="sheetname" display="SheetName" type="property"/>
|
|
<memberdata name="gridobject" display="GridObject" type="property"/>
|
|
<memberdata name="lockheader" display="LockHeader" type="property"/>
|
|
<memberdata name="columncount" display="ColumnCount" type="property"/>
|
|
<memberdata name="rowcount" display="RowCount" type="property"/>
|
|
<memberdata name="version" display="Version" type="property"/>
|
|
<memberdata name="setstyles" display="SetStyles" type="property"/>
|
|
<memberdata name="xmlencoding" display="xmlEncoding" type="property"/>
|
|
<memberdata name="openaftersaving" display="OpenAfterSaving" type="property"/>
|
|
<memberdata name="righttoleft" display="RightToLeft" type="property"/>
|
|
<memberdata name="save" display="Save" type="method"/>
|
|
<memberdata name="about" display="About" type="method"/>
|
|
<memberdata name="progress" display="Progress" type="method"/>
|
|
</VFPData>
|
|
*</PropValue>
|
|
|
|
PROCEDURE about && About ExcelXML class
|
|
messagebox("ExcelXML " + this.version.number + " " + this.version.datetime + this.CRLF +;
|
|
"Converts a Grid control into a Microsoft Excel XML file" + this.CRLF +;
|
|
"" + this.CRLF +;
|
|
"Created by "+ this.version.author + this.CRLF +;
|
|
this.version.CountryAndCity + this.CRLF +;
|
|
this.version.url + this.CRLF +;
|
|
this.version.email, 64, "About ExcelXML")
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE addnewstyle && Cria o estilo para o excel caso ainda não exista um igual e retorna o a string xml do estilo criado.
|
|
lparameters plcType, plnRow, plnCol ,;
|
|
plcAlignH, plcAlignV, plcFontName, plcFontFamily ,;
|
|
plcFontSize, plcForeColor, plcFontBold, plcFontItalic ,;
|
|
plcFontUnderline, plcFontStrikeThru, plcBackColor, plcPattern ,;
|
|
plcFormat
|
|
|
|
local lcStyleCode, lcXmlStyle
|
|
lcXmlStyle = ""
|
|
|
|
*- Definição de bordas entre as linhas/colunas (células)
|
|
lcXmlBorderStyle = ""
|
|
lcTop = "0"
|
|
lcBottom = "0"
|
|
|
|
if this.GridObject.GridLines >= 1 and this.Setstyles
|
|
lcGridLineWidth = iif(plcType="c", alltrim(str(iif(this.GridObject.GridLineWidth>=4, 3, this.GridObject.GridLineWidth))), "1")
|
|
lcGridLineColor = iif(plcType="c", this.ColorToStrHexa(this.GridObject.GridLineColor), this.ColorToStrHexa(rgb(100,100,100)))
|
|
lcXmlBorderStyle = [ <Borders>] + this.CRLF
|
|
|
|
*- Linhas na horizontal
|
|
if inlist(this.GridObject.GridLines, 1, 3)
|
|
lcXmlBorderStyle = lcXmlBorderStyle + [ <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="]+lcGridLineWidth+[" ss:Color="]+lcGridLineColor+["/>] + this.CRLF
|
|
lcXmlBorderStyle = lcXmlBorderStyle + [ <Border ss:Position="Bottom" ss:LineStyle="Continuous" ss:Weight="]+lcGridLineWidth+[" ss:Color="]+lcGridLineColor+["/>] + this.CRLF
|
|
endif
|
|
|
|
*- Linhas na vertical
|
|
if inlist(this.GridObject.GridLines, 2, 3)
|
|
if this.GridObject.GridLines = 2
|
|
if plnRow = 1 &&- Se for a primeira linha
|
|
lcTop = "1"
|
|
lcXmlBorderStyle = lcXmlBorderStyle + [ <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="]+lcGridLineWidth+[" ss:Color="]+lcGridLineColor+["/>] + this.CRLF
|
|
else
|
|
if plnRow = (this.RowCount-1) &&- Se for a ultima linha
|
|
lcBottom = "1"
|
|
lcXmlBorderStyle = lcXmlBorderStyle + [ <Border ss:Position="Bottom" ss:LineStyle="Continuous" ss:Weight="]+lcGridLineWidth+[" ss:Color="]+lcGridLineColor+["/>] + this.CRLF
|
|
endif
|
|
endif
|
|
endif
|
|
|
|
lcXmlBorderStyle = lcXmlBorderStyle + [ <Border ss:Position="Left" ss:LineStyle="Continuous" ss:Weight="]+lcGridLineWidth+[" ss:Color="]+lcGridLineColor+["/>] + this.CRLF
|
|
lcXmlBorderStyle = lcXmlBorderStyle + [ <Border ss:Position="Right" ss:LineStyle="Continuous" ss:Weight="]+lcGridLineWidth+[" ss:Color="]+lcGridLineColor+["/>] + this.CRLF
|
|
endif
|
|
|
|
lcXmlBorderStyle = lcXmlBorderStyle + [ </Borders>] + this.CRLF
|
|
else
|
|
lcXmlBorderStyle = [ <Borders></Borders>] + this.CRLF
|
|
endif
|
|
|
|
|
|
*- Adiciono no cursor caso não ache um registro com os mesmos dados
|
|
if not seek(plcAlignH + plcAlignV + plcFontName + plcFontFamily + ;
|
|
plcFontSize + plcForeColor + plcFontBold + plcFontItalic + ;
|
|
plcFontUnderline + plcFontStrikeThru + plcBackColor + plcPattern +;
|
|
plcFormat + lcTop + lcBottom ,;
|
|
"xxxStylesProperties","idxStyle")
|
|
|
|
this.StyleCodeNumber = this.StyleCodeNumber + 1
|
|
lcStyleCode = alltrim(lower(plcType))+transform(this.StyleCodeNumber, "@L 99999")
|
|
|
|
*- xml de estilo da celula
|
|
lcXmlStyle = [ <Style ss:ID="]+lcStyleCode+[">] + this.CRLF +;
|
|
[ <Alignment ss:Horizontal="]+alltrim(plcAlignH)+[" ss:Vertical="]+alltrim(plcAlignV)+["/>] + this.CRLF +;
|
|
[ <Font ss:FontName="]+alltrim(plcFontName)+[" x:Family="]+alltrim(plcFontFamily)+[" ss:Size="]+alltrim(str(val(plcFontSize)))+[" ss:Color="]+alltrim(plcForeColor)+["] + this.CRLF +;
|
|
[ ss:Bold="]+plcFontBold+[" ss:Italic="]+plcFontItalic+["]+iif(!empty(plcFontUnderline),[ ss:Underline="]+alltrim(plcFontUnderline)+["],"")+[ ss:StrikeThrough="]+alltrim(plcFontStrikeThru)+["/>] + this.CRLF +;
|
|
iif(this.SetStyles, [ <Interior ss:Color="]+alltrim(plcBackColor)+[" ss:Pattern="]+alltrim(plcPattern)+["/>], [ <Interior/>] ) + this.CRLF +;
|
|
iif(!empty(plcFormat), [ <NumberFormat ss:Format="]+alltrim(plcFormat)+["/>] + this.CRLF, "") +;
|
|
lcXmlBorderStyle +;
|
|
[ </Style>]
|
|
|
|
insert into xxxStylesProperties ;
|
|
values ( lcStyleCode ,;
|
|
plcAlignH ,;
|
|
plcAlignV ,;
|
|
plcFontName ,;
|
|
plcFontFamily ,;
|
|
plcFontSize ,;
|
|
plcForeColor ,;
|
|
plcFontBold ,;
|
|
plcFontItalic ,;
|
|
plcFontUnderline ,;
|
|
plcFontStrikeThru ,;
|
|
plcBackColor ,;
|
|
plcPattern ,;
|
|
plcFormat ,;
|
|
lcTop ,;
|
|
lcBottom ,;
|
|
lcXmlStyle )
|
|
endif
|
|
|
|
insert into xxxStylesRowCol ;
|
|
values ( transform(plnRow, "@L 999999") ,;
|
|
transform(plnCol, "@L 999") ,;
|
|
xxxStylesProperties.ssCode )
|
|
|
|
return lcXmlStyle
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE buildcolumnsstyles && Cria os estilos para uso das colunas e linhas. Ou seja, cada celula do grid é analizada para compor o seu estilo.
|
|
*!* 12.10.2016
|
|
*!* marius.mutu
|
|
*!* try catch endtry for dynamic properties (ex: this.readonly - error)
|
|
|
|
local lcAlignH, lcAlignV, lcFontName, lcFontFamily, ;
|
|
lcFontSize, lcForeColor, lcFontBold, lcFontItalic, ;
|
|
lcFontUnderline, lcFontStrikeThru, lcBackColor, lcPattern, ;
|
|
lcFormat, lcXmlBorderStyle, lcXmlStyles, lnRow, lnCol, lnRowFound
|
|
|
|
this.StyleCodeNumber = 0
|
|
lnRow = 0
|
|
lnCol = 0
|
|
lcXmlStyles = ""
|
|
|
|
|
|
*- Verifico os estilos de todas as linhas/colunas do grid
|
|
select (this.Alias)
|
|
go top
|
|
scan
|
|
lnRow = lnRow + 1
|
|
|
|
if not this.SetStyles and lnRow >= 2 &&- Não aplica os estilos ao grid.
|
|
exit
|
|
endif
|
|
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
loColumn = this.GetColumn(lnCol)
|
|
if not loColumn.Visible &&-Considero somente as colunas visiveis
|
|
loop
|
|
endif
|
|
|
|
*- Formato dos dados da linha/coluna (célula)
|
|
lcDataColumn = evaluate(loColumn.ControlSource)
|
|
loCurrentControl = this.GetCurrentControlObject(loColumn)
|
|
lcFormat = ""
|
|
|
|
if not isnull(loCurrentControl)
|
|
do case
|
|
case inlist(vartype(lcDataColumn),"N","Y")
|
|
if lower(loCurrentControl.BaseClass) $ "textbox//spinner"
|
|
if not empty(loColumn.InputMask)
|
|
lcInputMask = loColumn.InputMask
|
|
if occurs(".",lcInputMask) > 0
|
|
lcFormat = "#,##0." + replicate("0", len(subs(lcInputMask, rat(".",lcInputMask)+1)))
|
|
else
|
|
lcFormat = "#,##0"
|
|
endif
|
|
else
|
|
lnRowFound = ascan(this.AFields, iif("."$loColumn.ControlSource, substr(loColumn.ControlSource, at(".",loColumn.ControlSource)+1), loColumn.ControlSource), -1,-1, 1, 15)
|
|
if lnRowFound > 0 and this.AFields[lnRowFound,4] > 0
|
|
lcFormat = "#,##0." + replicate("0", this.AFields[lnRowFound,4])
|
|
else
|
|
lcFormat = ""
|
|
endif
|
|
endif
|
|
endif
|
|
|
|
if lower(loCurrentControl.BaseClass) $ "checkbox//optiongroup"
|
|
lcFormat = ""
|
|
endif
|
|
|
|
case vartype(lcDataColumn) = "D"
|
|
lcFormat = this.DateFormat + ";@"
|
|
|
|
case vartype(lcDataColumn) = "T"
|
|
if lower(loCurrentControl.BaseClass) = "textbox"
|
|
lnHasSeconds = loCurrentControl.Seconds
|
|
else
|
|
lnHasSeconds = 2
|
|
endif
|
|
|
|
if lnHasSeconds = 0
|
|
*- Data e hora sem segundos
|
|
lcFormat = this.DateFormat+"\ h:mm" + iif(set("hours")=12," AM/PM","")
|
|
else
|
|
*- Data e hora com segundos
|
|
lcFormat = this.DateFormat+"\ h:mm:ss" + iif(set("hours")=12," AM/PM","")
|
|
endif
|
|
|
|
case vartype(lcDataColumn) = "L"
|
|
lcFormat = "True/False"
|
|
|
|
otherwise
|
|
lcFormat = ""
|
|
endcase
|
|
endif
|
|
|
|
lcFormat = padr(lcFormat, len(xxxStylesProperties.ssFormat))
|
|
|
|
*- Requisitos fixos para o estilo
|
|
lcFontFamily = padr("Swiss", len(xxxStylesProperties.ssFontFamily))
|
|
lcPattern = padr("Solid", len(xxxStylesProperties.ssPattern))
|
|
|
|
*- Alinhamento Horizontal do texto da coluna/linha
|
|
if not isnull(loCurrentControl) and lower(loCurrentControl.BaseClass) = "combobox"
|
|
lcAlignH = this.GetColumnAlign("H", loCurrentControl.Alignment, vartype(lcDataColumn))
|
|
lcAlignV = this.GetColumnAlign("V", loCurrentControl.Alignment, vartype(lcDataColumn))
|
|
else
|
|
lcAlignH = this.GetColumnAlign("H", loColumn.Alignment, vartype(lcDataColumn))
|
|
lcAlignV = this.GetColumnAlign("V", loColumn.Alignment, vartype(lcDataColumn))
|
|
endif
|
|
|
|
*- cor de fundo da coluna/linha
|
|
if not empty(loColumn.DynamicBackColor)
|
|
TRY
|
|
lcBackColor = this.ColorToStrHexa( evaluate(loColumn.DynamicBackColor) )
|
|
CATCH
|
|
lcBackColor = this.ColorToStrHexa( loColumn.BackColor )
|
|
ENDTRY
|
|
else
|
|
lcBackColor = this.ColorToStrHexa( loColumn.BackColor )
|
|
endif
|
|
|
|
|
|
*- cor da fonte da coluna/linha
|
|
if not empty(loColumn.DynamicForeColor)
|
|
TRY
|
|
lcForeColor = this.ColorToStrHexa( evaluate(loColumn.DynamicForeColor) )
|
|
CATCH
|
|
lcForeColor = this.ColorToStrHexa( loColumn.ForeColor )
|
|
ENDTRY
|
|
else
|
|
lcForeColor = this.ColorToStrHexa( loColumn.ForeColor )
|
|
endif
|
|
|
|
|
|
*- fonte usada na coluna/linha
|
|
if not empty(loColumn.DynamicFontName)
|
|
TRY
|
|
lcFontName = evaluate(loColumn.DynamicFontName)
|
|
CATCH
|
|
lcFontName = loColumn.FontName
|
|
ENDTRY
|
|
else
|
|
lcFontName = loColumn.FontName
|
|
endif
|
|
lcFontName = padr(lcFontName, len(xxxStylesProperties.ssFontName))
|
|
|
|
|
|
*- tamanho da fonte da coluna/linha
|
|
if not empty(loColumn.DynamicFontSize)
|
|
TRY
|
|
lcFontSize = transform(evaluate(loColumn.DynamicFontSize), "@L 999")
|
|
CATCH
|
|
lcFontSize = transform(loColumn.FontSize, "@L 999")
|
|
ENDTRY
|
|
else
|
|
lcFontSize = transform(loColumn.FontSize, "@L 999")
|
|
endif
|
|
|
|
|
|
*- Fonte Italica da coluna/linha
|
|
if not empty(loColumn.DynamicFontItalic)
|
|
TRY
|
|
lcFontItalic = iif(evaluate(loColumn.DynamicFontItalic), "1", "0")
|
|
CATCH
|
|
lcFontItalic = iif(loColumn.FontItalic, "1", "0")
|
|
ENDTRY
|
|
else
|
|
lcFontItalic = iif(loColumn.FontItalic, "1", "0")
|
|
endif
|
|
|
|
|
|
*- Fonte Negrito da coluna/linha
|
|
if not empty(loColumn.DynamicFontBold)
|
|
TRY
|
|
lcFontBold = iif(evaluate(loColumn.DynamicFontBold), "1", "0")
|
|
CATCH
|
|
lcFontBold = iif(loColumn.FontBold, "1", "0")
|
|
ENDTRY
|
|
else
|
|
lcFontBold = iif(loColumn.FontBold, "1", "0")
|
|
endif
|
|
|
|
|
|
*- Fonte Underline da coluna/linha
|
|
if not empty(loColumn.DynamicFontUnderline)
|
|
TRY
|
|
lcFontUnderline = iif(evaluate(loColumn.DynamicFontUnderline), "Single", "")
|
|
CATCH
|
|
lcFontUnderline = iif(loColumn.FontUnderline, "Single", "")
|
|
ENDTRY
|
|
else
|
|
lcFontUnderline = iif(loColumn.FontUnderline, "Single", "")
|
|
endif
|
|
lcFontUnderline = padr(lcFontUnderline, len(xxxStylesProperties.ssFontUnderline))
|
|
|
|
|
|
*- Fonte Underline da coluna/linha
|
|
if not empty(loColumn.DynamicFontStrikeThru)
|
|
TRY
|
|
lcFontStrikeThru = iif(evaluate(loColumn.DynamicFontStrikeThru), "1", "0")
|
|
CATCH
|
|
lcFontStrikeThru = iif(loColumn.FontStrikeThru, "1", "0")
|
|
ENDTRY
|
|
else
|
|
lcFontStrikeThru = iif(loColumn.FontStrikeThru, "1", "0")
|
|
endif
|
|
lcFontStrikeThru = padr(lcFontStrikeThru, len(xxxStylesProperties.ssFontStrikeThru))
|
|
|
|
|
|
*- se o estilo já existir "lcXmlStyle" retorna ""
|
|
lcXmlStyle = this.AddNewStyle( "c", lnRow, lnCol, ;
|
|
lcAlignH, lcAlignV, lcFontName, lcFontFamily, ;
|
|
lcFontSize, lcForeColor, lcFontBold, lcFontItalic, ;
|
|
lcFontUnderline, lcFontStrikeThru, lcBackColor, lcPattern, ;
|
|
lcFormat )
|
|
|
|
if not empty(lcXmlStyle)
|
|
lcXmlStyles = lcXmlStyles + this.CRLF + lcXmlStyle
|
|
endif
|
|
endfor
|
|
endscan
|
|
|
|
return lcXmlStyles
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE buildcolumnswidth && Cria propriedades com as definições de cada coluna
|
|
local lcXmlColumnsWidth, lnCol, lnColumnWidth
|
|
lcXmlColumnsWidth = this.CRLF
|
|
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
loColumn = this.GetColumn(lnCol)
|
|
if loColumn.Visible = .T.
|
|
lnColumnWidth = iif(loColumn.width>700,700,loColumn.width) &&- Avoiding error in Excel
|
|
lcXmlColumnsWidth = lcXmlColumnsWidth + [ <Column ss:AutoFitWidth="0" ss:Width="]+alltrim(str(lnColumnWidth))+["/>] + this.CRLF
|
|
endif
|
|
endfor
|
|
|
|
return lcXmlColumnsWidth
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE buildheadersstyles && Cria os estilos para uso do cabeçalho
|
|
local loColumn, loColumnHeader, lnCol, lcXmlStyles, lcXmlStyle, ;
|
|
lcBackColor, lcForeColor, lcFontName, lcFontSize, lcFontItalic, ;
|
|
lcFontBold, lcFontUnderline, lcFontStrikeThru, lcFormat, ;
|
|
lcFontFamily, lcPattern, lcAlignH, lcAlignV, lcCollate
|
|
|
|
lcXmlStyle = ""
|
|
lcXmlStyles = ""
|
|
this.StyleCodeNumber = 0
|
|
lcCollate = set("Collate")
|
|
|
|
set collate to "MACHINE"
|
|
|
|
*- Crio cursor para armazenar todos os estilos encontrados
|
|
create cursor xxxStylesProperties ( ssCode c(6) ,;
|
|
ssAlignH c(6) ,;
|
|
ssAlignV c(6) ,;
|
|
ssFontName c(40) ,;
|
|
ssFontFamily c(5) ,;
|
|
ssFontSize c(3) ,;
|
|
ssFontColor c(7) ,;
|
|
ssFontBold c(1) ,;
|
|
ssFontItalic c(1) ,;
|
|
ssFontUnderline c(6) ,;
|
|
ssFontStrikeThru c(1) ,;
|
|
ssBackColor c(7) ,;
|
|
ssPattern c(5),;
|
|
ssFormat c(40) ,;
|
|
ssTop c(1) ,;
|
|
ssBottom c(1) ,;
|
|
ssStyle m )
|
|
|
|
|
|
|
|
select xxxStylesProperties
|
|
index on ssAlignH + ssAlignV + ssFontName + ;
|
|
ssFontFamily + ssFontSize + ssFontColor + ;
|
|
ssFontBold + ssFontItalic + ssFontUnderline + ssFontStrikeThru + ;
|
|
ssBackColor + ssPattern + ssFormat + ssTop + ssBottom tag idxStyle
|
|
|
|
index on ssCode tag idxCode
|
|
|
|
*- Crio cursor para gravar o estilo que sera usado pela linha/coluna (célula)
|
|
create cursor xxxStylesRowCol ( ssRow c(6) ,;
|
|
ssCol c(3) ,;
|
|
ssCode c(6) )
|
|
|
|
select xxxStylesRowCol
|
|
index on ssRow + ssCol tag idxRowCol
|
|
|
|
set collate to lcCollate
|
|
|
|
|
|
*- Verifico os estilos dos headers de cada coluna
|
|
if this.GridObject.HeaderHeight > 0
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
loColumn = this.GetColumn(lnCol)
|
|
loColumnHeader = this.GetColumnHeader(loColumn)
|
|
|
|
lcBackColor = this.ColorToStrHexa( iif(this.SetStyles, loColumnHeader.BackColor, rgb(255,255,255)) )
|
|
lcForeColor = this.ColorToStrHexa( iif(this.SetStyles, loColumnHeader.ForeColor, rgb(0,0,0)) )
|
|
lcFontName = padr(loColumnHeader.FontName, len(xxxStylesProperties.ssFontName))
|
|
lcFontSize = transform(loColumnHeader.FontSize, "@L 999")
|
|
lcFontItalic = iif(loColumnHeader.FontItalic, "1", "0")
|
|
lcFontBold = iif(loColumnHeader.FontBold or this.SetStyles=.f., "1", "0")
|
|
lcFontUnderline = padr(iif(loColumnHeader.FontUnderline or this.SetStyles=.f., "Single", ""), len(xxxStylesProperties.ssFontUnderline))
|
|
lcFontStrikeThru = iif(loColumnHeader.FontStrikeThru, "1", "0")
|
|
lcFormat = padr("", len(xxxStylesProperties.ssFormat))
|
|
lcFontFamily = padr("Swiss", len(xxxStylesProperties.ssFontFamily))
|
|
lcPattern = padr("Solid", len(xxxStylesProperties.ssPattern))
|
|
lcAlignH = iif(this.SetStyles, this.GetColumnAlign("H", loColumnHeader.Alignment), "Left")
|
|
lcAlignV = iif(this.SetStyles, this.GetColumnAlign("V", loColumnHeader.Alignment), "Center")
|
|
|
|
*- se o estilo já existir "lcXmlStyle" retorna ""
|
|
lcXmlStyle = this.AddNewStyle( "h", 0, lnCol, ;
|
|
lcAlignH, lcAlignV, lcFontName, lcFontFamily, ;
|
|
lcFontSize, lcForeColor, lcFontBold, lcFontItalic, ;
|
|
lcFontUnderline, lcFontStrikeThru, lcBackColor, lcPattern, ;
|
|
lcFormat )
|
|
|
|
if not empty(lcXmlStyle)
|
|
lcXmlStyles = lcXmlStyles + this.CRLF + lcXmlStyle
|
|
endif
|
|
endfor
|
|
endif
|
|
|
|
return lcXmlStyles
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE buildrows && Prepara o conteudo da tabela baseado nos estilos encontrados.
|
|
local lcXmlRows, lcDataType, lcDataColumn, lcAuxDataColumn, lnRow, lnCol, loColumn, loColumnHeader, loCurrentControl, ;
|
|
lnPercent, lnCountRowSource, lcCountOption, laArrayTmp, lcComboOption, lcToolTipText, lnBytes, llHasDecimals, ;
|
|
lnSetDecimals, lnRowFound, lnYear
|
|
|
|
lcXmlRows = this.CRLF
|
|
lnRow = 0
|
|
lnCol = 0
|
|
lnBytes = 0
|
|
lnSetDecimals = set("Decimals")
|
|
|
|
*- Adiciono a linha do Header no arquivo excel
|
|
if this.GridObject.HeaderHeight > 0
|
|
lcXmlRows = lcXmlRows + [ <Row ss:AutoFitHeight="0" ss:Height="]+alltrim(str(this.GridObject.HeaderHeight))+[">] + this.CRLF
|
|
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
loColumn = this.GetColumn(lnCol)
|
|
loColumnHeader = this.GetColumnHeader(loColumn)
|
|
|
|
if loColumn.Visible = .T.
|
|
*- caso tenha tooltiptext
|
|
lcToolTipText = ""
|
|
if not empty(loColumnHeader.ToolTipText)
|
|
lcToolTipText = [<Comment ss:Author="Rodrigo_Bruscain">]+;
|
|
[<ss:Data xmlns="http://www.w3.org/TR/REC-html40">]+;
|
|
[<Font html:Face="Tahoma" x:Family="Swiss" html:Color="#000000">]+alltrim(loColumnHeader.ToolTipText)+[</Font>]+;
|
|
[</ss:Data>]+;
|
|
[</Comment>]
|
|
endif
|
|
|
|
*- linha do header
|
|
lcXmlRows = lcXmlRows + [ <Cell ss:StyleID="]+this.SeekStyle("000000",transform(lnCol,"@L 999"))+["><Data ss:Type="String">]+loColumnHeader.caption+[</Data>]+lcToolTipText+[</Cell>] + this.CRLF
|
|
endif
|
|
endfor
|
|
|
|
lcXmlRows = lcXmlRows + [ </Row>] + this.CRLF
|
|
endif
|
|
|
|
lcXmlRows = lcXmlRows + this.CRLF
|
|
|
|
*- Adiciono a linha do Registro no arquivo excel
|
|
select (this.Alias)
|
|
go top
|
|
scan
|
|
lnRow = lnRow + 1
|
|
lcXmlRows = lcXmlRows + [ <Row ss:AutoFitHeight="0">] + this.CRLF
|
|
|
|
*- percentual processado
|
|
lnPercent = int((lnRow / (this.RowCount - (iif(this.GridObject.HeaderHeight > 0, 1, 0))) ) * 100)
|
|
this.Progress(lnPercent)
|
|
|
|
*- faço a varredura em todas as colunas
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
loColumn = this.GetColumn(lnCol)
|
|
if not loColumn.Visible
|
|
loop
|
|
endif
|
|
|
|
*- Verifico o tipo de dado da coluna
|
|
lcDataColumn = evaluate(loColumn.ControlSource)
|
|
loCurrentControl = this.GetCurrentControlObject(loColumn)
|
|
|
|
*- se não tem objeto de controle na linha da coluna não levo a informação da tabela ao excel
|
|
if isnull(loCurrentControl)
|
|
lcDataType = "String"
|
|
lcDataColumn = ""
|
|
else
|
|
do case
|
|
case vartype(lcDataColumn) $ "N//Y"
|
|
lcDataType = "Number"
|
|
|
|
*- Se o currentcontrol da coluna for um combobox mostro o seu conteudo ao inves da posição numerica
|
|
if lower(loCurrentControl.BaseClass) = "combobox"
|
|
try
|
|
do case
|
|
*- Mostro o texto do value
|
|
case loCurrentControl.RowSourceType = 1
|
|
lcDataType = "String"
|
|
|
|
if not empty(loCurrentControl.RowSource)
|
|
lcAuxDataColumn = alltrim(loCurrentControl.RowSource)
|
|
lcAuxDataColumn = strtran(strtran(strtran(lcAuxDataColumn," ,",","), ", ",","), " , ", ",")
|
|
lcCountOption = occurs(",",lcAuxDataColumn)+1
|
|
|
|
dimension laArrayTmp[lcCountOption]
|
|
for lnCountRowSource = 1 to lcCountOption
|
|
lcComboOption = substr(lcAuxDataColumn, 1, iif(lnCountRowSource < lcCountOption, at(",",lcAuxDataColumn)-1, len(lcAuxDataColumn)) )
|
|
lcAuxDataColumn = strtran(lcAuxDataColumn, lcComboOption + iif(lcCountOption>=2,",",""), "")
|
|
laArrayTmp[lnCountRowSource] = lcComboOption
|
|
endfor
|
|
|
|
lcDataColumn = evaluate("laArrayTmp["+alltrim(str(lcDataColumn))+"]")
|
|
endif
|
|
|
|
*- Mostro o texto do array do combo
|
|
case loCurrentControl.RowSourceType = 5
|
|
lcDataType = "String"
|
|
|
|
*- Se for um array objeto ex: thisform.ArrayName ou MyObj.ArrayName
|
|
if occurs(".", loCurrentControl.RowSource) > 0
|
|
lcObjArrayName = substr(loCurrentControl.RowSource, 1, rat(".",loCurrentControl.RowSource)-1)
|
|
|
|
*- Se for um array objeto publico
|
|
if type(lcObjArrayName) = "O"
|
|
lcAuxDataColumn = loCurrentControl.RowSource+"["+alltrim(str(lcDataColumn))+"]"
|
|
else
|
|
lcArrayName = substr(loCurrentControl.RowSource, rat(".",loCurrentControl.RowSource)+1)
|
|
lnCountObjectHierarchy = occurs(".", sys(1272, this.GridObject))
|
|
lcAuxDataColumn = "this.GridObject"+replicate(".Parent",lnCountObjectHierarchy)+"."+lcArrayName+"["+alltrim(str(lcDataColumn))+"]"
|
|
endif
|
|
|
|
*- Array comum
|
|
else
|
|
lcAuxDataColumn = loCurrentControl.RowSource+"["+alltrim(str(lcDataColumn))+"]"
|
|
endif
|
|
|
|
lcDataColumn = evaluate(lcAuxDataColumn)
|
|
|
|
|
|
*- Qualquer outro mostro o conteudo do campo e não o conteudo do array
|
|
otherwise
|
|
lcDataColumn = lcDataColumn
|
|
endcase
|
|
|
|
catch to loError
|
|
endtry
|
|
|
|
if vartype(loError) = "O"
|
|
messagebox( "Combo array '"+loCurrentControl.RowSource+"' in column '"+loColumn.name+"' not is valid", 48)
|
|
select (this.Alias)
|
|
go top
|
|
return .f.
|
|
endif
|
|
else
|
|
|
|
lnRowFound = ascan(this.AFields, iif("."$loColumn.ControlSource, substr(loColumn.ControlSource, at(".",loColumn.ControlSource)+1), loColumn.ControlSource), -1,-1, 1, 15)
|
|
if lnRowFound > 0 and this.AFields[lnRowFound,4] > 0
|
|
llHasDecimals = .t.
|
|
set decimals to this.AFields[lnRowFound,4]
|
|
else
|
|
llHasDecimals = .f.
|
|
endif
|
|
|
|
endif
|
|
|
|
case vartype(lcDataColumn) = "D"
|
|
lcDataType = "DateTime"
|
|
if not empty(nvl(lcDataColumn,""))
|
|
lnYear = iif(year(lcDataColumn)<1900,1900,year(lcDataColumn))
|
|
lcAuxDataColumn = str(lnYear,4)+"-"+transform(month(lcDataColumn),"@L 99")+"-"+transform(day(lcDataColumn),"@L 99")+"T00:00:00.000"
|
|
lcDataColumn = lcAuxDataColumn
|
|
else
|
|
lcDataType = "String"
|
|
lcDataColumn = ""
|
|
endif
|
|
|
|
case vartype(lcDataColumn) = "T"
|
|
lcDataType = "DateTime"
|
|
if not empty(nvl(lcDataColumn,""))
|
|
lnYear = iif(year(lcDataColumn)<1900,1900,year(lcDataColumn))
|
|
lcAuxDataColumn = str(lnYear,4)+"-"+transform(month(lcDataColumn),"@L 99")+"-"+transform(day(lcDataColumn),"@L 99")+;
|
|
"T"+transform(hour(lcDataColumn),"@L 99")+":"+transform(minute(lcDataColumn),"@L 99")+":"+transform(sec(lcDataColumn),"@L 99")+".000"
|
|
lcDataColumn = lcAuxDataColumn
|
|
else
|
|
lcDataType = "String"
|
|
lcDataColumn = ""
|
|
endif
|
|
|
|
case vartype(lcDataColumn) = "L"
|
|
lcDataType = "Number"
|
|
lcDataColumn = iif(lcDataColumn, 1, 0)
|
|
|
|
otherwise
|
|
lcDataType = "String"
|
|
if isnull(lcDataColumn)
|
|
lcDataColumn = ""
|
|
endif
|
|
endcase
|
|
endif
|
|
|
|
*- removing invalid characters
|
|
if lcDataType = "String" and ("<" $ lcDataColumn or ">" $ lcDataColumn)
|
|
lcDataColumn = strtran(strtran(lcDataColumn, "<", "["), ">", "]")
|
|
endif
|
|
|
|
*- incluo a linha de dados
|
|
lcXmlRows = lcXmlRows + [ <Cell ss:StyleID="]+this.SeekStyle(transform(lnRow,"@L 999999"),transform(lnCol,"@L 999"))+["><Data ss:Type="]+lcDataType+[">]+alltrim(transform(lcDataColumn, ""))+[</Data></Cell>] + this.CRLF
|
|
|
|
*- devolvo o atributo original
|
|
if llHasDecimals
|
|
set decimals to lnSetDecimals
|
|
endif
|
|
endfor
|
|
|
|
lcXmlRows = lcXmlRows + [ </Row>] + this.CRLF
|
|
lnBytes = lnBytes + strtofile( lcXmlRows + this.CRLF, this.File, 1)
|
|
lcXmlRows = ""
|
|
|
|
endscan
|
|
|
|
return lnBytes
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE colortostrhexa && Converto a cor do vfp para hexadecimal
|
|
lparameters plnColor
|
|
local lnDecimalColor
|
|
lnDecimalColor = substr(transform(plnColor, '@0'),5)
|
|
return "#"+right(lnDecimalColor,2) + substr(lnDecimalColor,3,2) + left(lnDecimalColor,2)
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE getcolumn && Retorna o objeto da coluna conforme sua ordem de apresentação no grid
|
|
lparameters plcColumnNumber
|
|
local lnCol
|
|
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
if this.GridObject.Columns(lnCol).ColumnOrder = plcColumnNumber
|
|
return this.GridObject.Columns(lnCol)
|
|
endif
|
|
endfor
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE getcolumnalign && Retorna o alinhamento de um objeto para ser usado na linha/coluna (célula) do Excel
|
|
lparameters plcWhat, plnAlignment, plcVartype
|
|
local lcAlignment, lcAlignH, lcAlignV
|
|
plcVartype = evl(plcVartype,"")
|
|
lcAlignment = alltrim(str(plnAlignment))
|
|
|
|
*- Alinhamento Horizontal do texto da coluna/linha
|
|
if plcWhat = "H"
|
|
do case
|
|
case lcAlignment $ "0//4//7"
|
|
lcAlignH = "Left"
|
|
case lcAlignment $ "1//5//8"
|
|
lcAlignH = "Right"
|
|
case lcAlignment $ "2//6//9"
|
|
lcAlignH = "Center"
|
|
otherwise
|
|
lcAlignH = iif(plcVartype $ "N//Y", "Right", "Left")
|
|
endcase
|
|
|
|
lcAlignH = padr(lcAlignH, len(xxxStylesProperties.ssAlignH))
|
|
return lcAlignH
|
|
endif
|
|
|
|
*- Alinhamento vertical do texto da coluna/linha
|
|
if plcWhat = "V"
|
|
do case
|
|
case lcAlignment $ "4//5//6"
|
|
lcAlignV = "Top"
|
|
case lcAlignment $ "7//8//9"
|
|
lcAlignV = "Bottom"
|
|
case lcAlignment $ "0//1//2"
|
|
lcAlignV = "Center"
|
|
otherwise
|
|
lcAlignV = "Center"
|
|
endcase
|
|
|
|
lcAlignV = padr(lcAlignV, len(xxxStylesProperties.ssAlignV))
|
|
return lcAlignV
|
|
endif
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE getcolumnheader && Retorna o nome do header da coluna indicada
|
|
lparameters ploColumn
|
|
local loReturn, lnx
|
|
loReturn = ""
|
|
|
|
if ploColumn.ControlCount > 0
|
|
for lnx = 1 to ploColumn.ControlCount
|
|
if lower(ploColumn.Controls(lnx).BaseClass) = "header"
|
|
loReturn = ploColumn.Controls(lnx)
|
|
exit
|
|
endif
|
|
endfor
|
|
endif
|
|
|
|
return loReturn
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE getcurrentcontrolobject && Retorna o objeto corrente dentro da linha/coluna
|
|
lparameters ploGridColumn
|
|
local lcCurrentControl
|
|
|
|
if not empty(ploGridColumn.DynamicCurrentControl)
|
|
lcCurrentControl = evaluate(ploGridColumn.DynamicCurrentControl)
|
|
else
|
|
lcCurrentControl = ploGridColumn.CurrentControl
|
|
endif
|
|
|
|
if not empty(lcCurrentControl)
|
|
return evaluate("ploGridColumn."+lcCurrentControl)
|
|
else
|
|
return null
|
|
endif
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE hascolumnvisible && Retorna o numero de colunas visiveis no grid
|
|
local lnCol, llReturn
|
|
llReturn = .f.
|
|
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
if this.GridObject.Columns(lnCol).Visible
|
|
llReturn = .t.
|
|
exit
|
|
endif
|
|
endfor
|
|
|
|
return llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
*/---------------------------------------------------------------------------------------------------/*
|
|
*/ Descripton..: - Classe para converter o grid do vfp em um arquivo xml para o Excel. /*
|
|
*/ - A grande vantagem na utilização é que NÃO NECESSITA DO EXCEL INSTALADO /*
|
|
*/ pois em nenhum momento o Excel é instanciado para automação. /*
|
|
*/ Apesar de ser um arquivo xml, se encontra no padrão Microsoft onde é reconhecido /*
|
|
*/ pelo Excel como "Planilha XML 2003 (*.xml)". Dessa forma fica restrito o uso /*
|
|
*/ para Excel 2003 ou superior. /*
|
|
*/ /*
|
|
*/ - Se o Excel estiver instalado o icone do arquivo gerado será reconhecido /*
|
|
*/ pelo Excel e abrindo o arquivo será reconhecido como se fosse um XLS ou XLSX, /*
|
|
*/ ou seja, tudo será transparente para o Excel. /*
|
|
*/ /*
|
|
*/ - Praticamente todos os recursos visuais do grid, headers, colunas e linhas /*
|
|
*/ são tratados na exportação. Segue abaixo as propriedades reconhecidas: /*
|
|
*/ /*
|
|
*/ Header Properties /*
|
|
*/ --------------------------------- /*
|
|
*/ ToolTipText / HeaderHeight / Alignment / FontBold / FontItalic / FontUnderline / /*
|
|
*/ FontStrikeThru / FontName / FontSize / ForeColor / BackColor / Caption / /*
|
|
*/ /*
|
|
*/ Columns Properties /*
|
|
*/ --------------------------------- /*
|
|
*/ ControlSource / BaseClass / InputMask / Seconds / RowHeight / Alignment / /*
|
|
*/ FontBold / FontItalic / FontUnderline / FontStrikeThru / FontName / FontSize / /*
|
|
*/ ForeColor / FontBackColor / CurrentControl / DynamicFontBold / DynamicFontItalic /*
|
|
*/ DynamicFontUnderline / DynamicFontStrikeThru / DynamicCurrentControl / /*
|
|
*/ DynamicFontName / DynamicFontSize / DynamicForeColor / DynamicBackColor / /*
|
|
*/ ColumnCount / ColumnOrder / Width / Visible / Combobox.Alignment / /*
|
|
*/ Combobox.RowSource / Combobox.RowSourceType /*
|
|
*/ /*
|
|
*/ Environment /*
|
|
*/ --------------------------------- /*
|
|
*/ set date / set century / set hours /*
|
|
*/ /*
|
|
*/
|
|
*/ Goals
|
|
*/ ------
|
|
*/ a) Possibilidade de gerar planilhas com mais de 65,535 linhas superando
|
|
*/ a limitaçao nativa do VFP
|
|
*/ b) Converte um grid em planilha Excel assumindo 99% do visual do grid
|
|
*/ c) Easy to implement and it is not necessary to change your code
|
|
*/ d) Compativel com Excel 2003 ou superior
|
|
*/ e) Pode ser aberto pelo OpenOffice reduzindo erros de conversão
|
|
*/ f) Ao abrir o arquivo pelo Excel é possivel salvar em outros formatos
|
|
*/ g) Nao precisa ter o Excel instalado
|
|
*/
|
|
*/ /*
|
|
*/ Author......: Rodrigo Bruscain /*
|
|
*/ Date........: 25/05/2013 /*
|
|
*/ Country.....: Brazil - São Paulo - SP /*
|
|
*/ Version.....: 1.08 /*
|
|
*/---------------------------------------------------------------------------------------------------/*
|
|
|
|
|
|
this.CRLF = chr(13) + chr(10)
|
|
|
|
|
|
local lcDateFormat, lcCentury
|
|
lcDateFormat = set("Date")
|
|
lcCentury = iif(set("century")="ON","yyyy","yy")
|
|
|
|
do case
|
|
case inlist(lcDateFormat, "AMERICAN", "MDY") && month/day/year
|
|
this.DateFormat = "mm/dd/"+lcCentury
|
|
|
|
case lcDateFormat = "ANSI" && year.month.day
|
|
this.DateFormat = lcCentury+".mm.dd"
|
|
|
|
case inlist(lcDateFormat, "BRITISH", "DMY", "FRENCH") && day/month/year
|
|
this.DateFormat = "dd/mm/"+lcCentury
|
|
|
|
case lcDateFormat = "GERMAN" && day.month.year
|
|
this.DateFormat = "dd.mm."+lcCentury
|
|
|
|
case lcDateFormat = "ITALIAN" && day-month-year
|
|
this.DateFormat = "dd-mm-"+lcCentury
|
|
|
|
case inlist(lcDateFormat, "JAPAN", "YMD") && year/month/day
|
|
this.DateFormat = lcCentury+"/mm/dd"
|
|
|
|
case lcDateFormat = "USA" && month-day-year
|
|
this.DateFormat = "mm-dd-"+lcCentury
|
|
|
|
otherwise
|
|
this.DateFormat = "dd/mm/"+lcCentury
|
|
endcase
|
|
|
|
|
|
|
|
*- version object
|
|
this.version = createobject("empty")
|
|
addproperty(this.version, "Number", "Beta 1.08")
|
|
addproperty(this.version, "DateTime", "Feb.21.2014 3:59:41 AM")
|
|
addproperty(this.version, "Author", "Rodrigo Duarte Bruscain")
|
|
addproperty(this.version, "CountryAndCity", "kitchener ON - Canada")
|
|
addproperty(this.version, "Url", "http://vfpx.codeplex.com/wikipage?title=ExcelXML")
|
|
addproperty(this.version, "Email", "bruscain@hotmail.com")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE progress && Method used to show the percentage processed.
|
|
lparameters plnPercent
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE save && Creates the Excel XML file.
|
|
lparameters plcFile
|
|
local lcCreatedDate, lnCol, lcSetPoint, loForm, lcAlias, lnRecno, ;
|
|
lcXmlStart, lcXmlDocumentProperties, lcXmlExcelWorkbook, lcStringStyles, ;
|
|
lcXmlAllStyles, lcXmlFreezePanes, lcStringFilter, lcStringColumnWidth, ;
|
|
lcXmlWorksheet_part1, lcXmlWorksheet_part2, lnBytes, loError
|
|
|
|
plcFile = iif(empty(plcFile),"Book1",plcFile)
|
|
this.File = iif(empty(this.File),plcFile,this.File)
|
|
this.File = this.File + iif(empty(justext(this.File)),".XML","")
|
|
|
|
if empty(alias())
|
|
messagebox("No table is open in the current work area. ", 48)
|
|
return .f.
|
|
endif
|
|
|
|
*- crio um grid virtual caso a nao exista um grid para conversao,
|
|
*- ou seja, estou convertendo somente a tabela
|
|
if vartype(this.GridObject) <> "O"
|
|
loForm = createobject("form")
|
|
loForm.AddObject("grid1","grid")
|
|
loForm.Grid1.RecordSource = alias()
|
|
loForm.Grid1.visible = .t.
|
|
loForm.refresh()
|
|
this.GridObject = loForm.Grid1
|
|
this.SetStyles = .f.
|
|
endif
|
|
|
|
|
|
*- environment
|
|
if this.GridObject.RecordSourceType = 1
|
|
this.Alias = this.GridObject.RecordSource
|
|
else
|
|
this.Alias = alias()
|
|
endif
|
|
|
|
lnRecno = recno()
|
|
afields(this.afields,this.Alias)
|
|
|
|
|
|
*- Data da criação do arquivo excel
|
|
lcCreatedDate = str(year(date()),4)+"-"+transform(month(date()),"@L 99")+"-"+transform(day(date()),"@L 99")+"T"+time()+"Z"
|
|
|
|
*- Numero de colunas válidas para o excel
|
|
this.ColumnCount = 0
|
|
for lnCol = 1 to this.GridObject.ColumnCount
|
|
if this.GridObject.Columns(lnCol).Visible = .T.
|
|
this.ColumnCount = this.ColumnCount + 1
|
|
endif
|
|
endfor
|
|
|
|
*- Numero de linhas disponíveis para o excel
|
|
this.RowCount = 0
|
|
select (this.Alias)
|
|
count to this.RowCount
|
|
go top
|
|
|
|
if this.GridObject.HeaderHeight > 0
|
|
this.RowCount = this.RowCount + 1
|
|
endif
|
|
|
|
*- verifico se tudo esta ok para prosseguir
|
|
if isnull(this.GridObject) or this.GridObject.ColumnCount <= 0 and this.HasColumnVisible()
|
|
return .f.
|
|
endif
|
|
|
|
*- No Excel casas decimais obrigatóriamente trabalham com ponto "."
|
|
lcSetPoint = set("Point")
|
|
set point to "."
|
|
|
|
*- Inicio tratamento dos dados
|
|
text to lcXmlStart textmerge pretext 2 noshow
|
|
<?xml version="1.0" encoding="<<this.xmlEncoding>>"?>
|
|
<?mso-application progid="Excel.Sheet"?>
|
|
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
|
|
xmlns:o="urn:schemas-microsoft-com:office:office"
|
|
xmlns:x="urn:schemas-microsoft-com:office:excel"
|
|
xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
|
|
xmlns:html="http://www.w3.org/TR/REC-html40">
|
|
endtext
|
|
|
|
text to lcXmlDocumentProperties textmerge pretext 2 noshow
|
|
<DocumentProperties xmlns="urn:schemas-microsoft-com:office:office">
|
|
<Author><<iif(!empty(getenv("USERNAME")), getenv("USERNAME"), iif(!empty(getenv("COMPUTERNAME")), getenv("COMPUTERNAME"), "RODRIGO_BRUSCAIN"))>></Author>
|
|
<LastAuthor><<iif(!empty(getenv("USERNAME")), getenv("USERNAME"), iif(!empty(getenv("COMPUTERNAME")), getenv("COMPUTERNAME"), "RODRIGO_BRUSCAIN"))>></LastAuthor>
|
|
<Created><<lcCreatedDate>></Created>
|
|
<LastSaved><<lcCreatedDate>></LastSaved>
|
|
<Version>12.00</Version>
|
|
</DocumentProperties>
|
|
endtext
|
|
|
|
text to lcXmlExcelWorkbook textmerge pretext 2 noshow
|
|
<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">
|
|
<WindowHeight>8130</WindowHeight>
|
|
<WindowWidth>15135</WindowWidth>
|
|
<WindowTopX>120</WindowTopX>
|
|
<WindowTopY>45</WindowTopY>
|
|
<ProtectStructure>False</ProtectStructure>
|
|
<ProtectWindows>False</ProtectWindows>
|
|
</ExcelWorkbook>
|
|
endtext
|
|
|
|
|
|
*- Crio os estilos de cores/fontes/formato/etc das colunas
|
|
*- Depois junto com o estilo padrão todos os estilos encontrados
|
|
*- Estilos são todas as formatões da células combinadas onde um estilo pode ser usado
|
|
*- por várias céluas ou por uma única célula.
|
|
lcStringStyles = ""
|
|
lcStringStyles = this.BuildHeadersStyles() &&- Estilos do header
|
|
lcStringStyles = lcStringStyles + this.BuildColumnsStyles() &&- Estilos das linhas/colunas
|
|
|
|
text to lcXmlAllStyles textmerge pretext 2 noshow
|
|
<Styles>
|
|
<Style ss:ID="Default" ss:Name="Normal">
|
|
<Alignment ss:Vertical="Center"/>
|
|
<Borders/>
|
|
<Font ss:FontName="Arial" x:Family="Swiss" ss:Size="9" ss:Color="#000000"/>
|
|
<Interior/>
|
|
<NumberFormat/>
|
|
<Protection/>
|
|
</Style>
|
|
<<lcStringStyles>>
|
|
</Styles>
|
|
endtext
|
|
|
|
|
|
*- Congelando paineis na horizontal e vertical
|
|
do case
|
|
*- Congelo a linha do header
|
|
case this.GridObject.LockColumns = 0 and (this.GridObject.HeaderHeight > 0 and this.LockHeader)
|
|
text to lcXmlFreezePanes textmerge pretext 2 noshow
|
|
<FreezePanes/>
|
|
<FrozenNoSplit/>
|
|
<SplitHorizontal>1</SplitHorizontal>
|
|
<TopRowBottomPane>1</TopRowBottomPane>
|
|
<ActivePane>2</ActivePane>
|
|
<Panes>
|
|
<Pane>
|
|
<Number>3</Number>
|
|
</Pane>
|
|
<Pane>
|
|
<Number>2</Number>
|
|
</Pane>
|
|
</Panes>
|
|
endtext
|
|
|
|
*- congelo a linha do header e a coluna definida
|
|
case this.GridObject.LockColumns > 0 and (this.GridObject.HeaderHeight > 0 and this.LockHeader)
|
|
text to lcXmlFreezePanes textmerge pretext 2 noshow
|
|
<FreezePanes/>
|
|
<FrozenNoSplit/>
|
|
<SplitHorizontal>1</SplitHorizontal>
|
|
<TopRowBottomPane>1</TopRowBottomPane>
|
|
<SplitVertical><<alltrim(str(this.GridObject.LockColumns))>></SplitVertical>
|
|
<LeftColumnRightPane><<alltrim(str(this.GridObject.LockColumns))>></LeftColumnRightPane>
|
|
<ActivePane>0</ActivePane>
|
|
<Panes>
|
|
<Pane>
|
|
<Number>3</Number>
|
|
</Pane>
|
|
<Pane>
|
|
<Number>1</Number>
|
|
</Pane>
|
|
<Pane>
|
|
<Number>2</Number>
|
|
</Pane>
|
|
<Pane>
|
|
<Number>0</Number>
|
|
</Pane>
|
|
</Panes>
|
|
endtext
|
|
|
|
*- congelo somente a coluna definida
|
|
case this.GridObject.LockColumns > 0 and (this.GridObject.HeaderHeight = 0 or not this.LockHeader)
|
|
text to lcXmlFreezePanes textmerge pretext 2 noshow
|
|
<FreezePanes/>
|
|
<FrozenNoSplit/>
|
|
<SplitVertical>2</SplitVertical>
|
|
<LeftColumnRightPane>2</LeftColumnRightPane>
|
|
<ActivePane>1</ActivePane>
|
|
<Panes>
|
|
<Pane>
|
|
<Number>3</Number>
|
|
</Pane>
|
|
<Pane>
|
|
<Number>1</Number>
|
|
</Pane>
|
|
</Panes>
|
|
endtext
|
|
|
|
otherwise
|
|
lcXmlFreezePanes = ""
|
|
endcase
|
|
|
|
|
|
*- filtros na colunas
|
|
lcStringFilter = ""
|
|
if this.HasFilter and this.GridObject.HeaderHeight > 0
|
|
text to lcStringFilter textmerge pretext 2 noshow
|
|
<AutoFilter x:Range="R1C1:R<<alltrim(str(this.RowCount))>>C<<alltrim(str(this.ColumnCount))>>"
|
|
xmlns="urn:schemas-microsoft-com:office:excel">
|
|
</AutoFilter>
|
|
endtext
|
|
endif
|
|
|
|
|
|
*- tratamento do nome da planilha
|
|
this.SheetName = chrtran(alltrim(substr(this.SheetName,1,31)), ':?][*/\','')
|
|
this.SheetName = iif(empty(this.SheetName),"Sheet1", this.SheetName)
|
|
|
|
*- Monto a tabela
|
|
lcStringColumnWidth = this.BuildColumnsWidth()
|
|
|
|
text to lcXmlWorksheet_part1 textmerge pretext 2 noshow
|
|
<Worksheet ss:Name="<<this.SheetName>>">
|
|
<Table ss:ExpandedColumnCount="<<this.ColumnCount>>" ss:ExpandedRowCount="<<this.RowCount>>" x:FullColumns="1"
|
|
x:FullRows="1" ss:DefaultRowHeight="<<alltrim(str(this.GridObject.RowHeight-3))>>">
|
|
<<lcStringColumnWidth>>
|
|
endtext
|
|
|
|
text to lcXmlWorksheet_part2 textmerge pretext 2 noshow
|
|
</Table>
|
|
<WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">
|
|
<PageSetup>
|
|
<Header x:Margin="0.31496062000000002"/>
|
|
<Footer x:Margin="0.31496062000000002"/>
|
|
<PageMargins x:Bottom="0.78740157499999996" x:Left="0.511811024"
|
|
x:Right="0.511811024" x:Top="0.78740157499999996"/>
|
|
</PageSetup>
|
|
<Unsynced/>
|
|
<Print>
|
|
<ValidPrinterInfo/>
|
|
<PaperSizeIndex>9</PaperSizeIndex>
|
|
<HorizontalResolution>300</HorizontalResolution>
|
|
<VerticalResolution>300</VerticalResolution>
|
|
</Print>
|
|
<Selected/>
|
|
<<lcXmlFreezePanes>>
|
|
<ProtectObjects>False</ProtectObjects>
|
|
<ProtectScenarios>False</ProtectScenarios>
|
|
</WorksheetOptions>
|
|
<<lcStringFilter>>
|
|
</Worksheet>
|
|
</Workbook>
|
|
endtext
|
|
|
|
try
|
|
lnBytes = 0
|
|
lnBytes = lnBytes + strtofile("", this.File, 0)
|
|
lnBytes = lnBytes + strtofile( lcXmlStart + this.CRLF, this.File, 1)
|
|
lnBytes = lnBytes + strtofile( lcXmlDocumentProperties + this.CRLF, this.File, 1)
|
|
lnBytes = lnBytes + strtofile( lcXmlExcelWorkbook + this.CRLF, this.File, 1)
|
|
lnBytes = lnBytes + strtofile( lcXmlAllStyles + this.CRLF, this.File, 1)
|
|
lnBytes = lnBytes + strtofile( lcXmlWorksheet_part1 + this.CRLF, this.File, 1)
|
|
lnBytes = lnBytes + this.BuildRows()
|
|
lnBytes = lnBytes + strtofile( lcXmlWorksheet_part2 + this.CRLF, this.File, 1)
|
|
|
|
llReturn = iif(lnBytes > 0, .T., .F.)
|
|
|
|
catch to loError
|
|
if file(this.File)
|
|
erase (this.File)
|
|
endif
|
|
|
|
messagebox("An error occurred during the data exporting. "+chr(13)+"Error: "+loError.message,16,"Exporting")
|
|
|
|
llReturn = .F.
|
|
endtry
|
|
|
|
*select xxxStylesRowCol
|
|
*browse normal
|
|
*select xxxStylesProperties
|
|
*browse normal
|
|
|
|
set point to &lcSetPoint
|
|
|
|
if used("xxxStylesProperties")
|
|
use in xxxStylesProperties
|
|
endif
|
|
|
|
if used("xxxStylesRowCol")
|
|
use in xxxStylesRowCol
|
|
endif
|
|
|
|
if used(this.Alias)
|
|
TRY
|
|
go lnRecno
|
|
CATCH
|
|
ENDTRY
|
|
endif
|
|
|
|
if vartype(this.GridObject) <> "O"
|
|
loForm.Release()
|
|
endif
|
|
|
|
this.GridObject = .null.
|
|
|
|
if used(this.Alias)
|
|
select (this.Alias)
|
|
endif
|
|
|
|
*- abre o arquivo apos salva-lo
|
|
if llReturn and this.OpenAfterSaving
|
|
declare integer ShellExecute in SHELL32.dll as WinAPI_OpenAfterSavingExcelXML;
|
|
integer HndWin, string cAction, string cFileName,;
|
|
string cParams, string cDir, integer nShowWin
|
|
|
|
WinAPI_OpenAfterSavingExcelXML(0,"OPEN",this.file,"","",1)
|
|
clear dlls "WinAPI_OpenAfterSavingExcelXML"
|
|
endif
|
|
|
|
return llReturn
|
|
|
|
ENDPROC
|
|
|
|
PROTECTED PROCEDURE seekstyle && Busco o estilo que será usado na Coluna/Linha (célula)
|
|
lparameters plcRow, plcCol
|
|
local lcReturn
|
|
lcReturn = ""
|
|
|
|
*- se nao aplica estilos
|
|
if not this.SetStyles and plcRow > "000001"
|
|
plcRow = "000001"
|
|
endif
|
|
|
|
*- Procuro um estilo para a celula, caso nao encontre aplico o padrão.
|
|
*- Teoricamente todas as celulas deve ter um estilo e não o padrão.
|
|
if seek(plcRow + plcCol, "xxxStylesRowCol", "idxRowCol")
|
|
lcReturn = xxxStylesRowCol.ssCode
|
|
else
|
|
lcReturn = "Default"
|
|
endif
|
|
|
|
return lcReturn
|
|
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|