*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="exportxlsx.vcx" CPID="1250" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS exportxlsx AS commandbutton *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: cleanup *m: cleanup2 *m: copytoxlsx *m: gen_app *m: gen_content_types *m: gen_core *m: gen_dirs *m: gen_rels *m: gen_styles *m: gen_workbook *m: gen_workbook2 *m: gen_workbook3 && For comments *m: getcurr *m: htmspec *m: langset *m: testprop *m: thefirsttime *p: autocolw *p: cfields *p: cfieldstotal *p: cheaders *p: grid *p: headbackcolor *p: headfill *p: headfontbold *p: headfontitalic *p: headfontname *p: headfontsize *p: headforecolor *p: label *p: langid *p: lastcol *p: lastrow *p: lerror *p: lfirst *p: lhead *p: lmemoascomment && When .T. memo fields are converted into comments while the cell contains the word "Memo" *p: lopen *p: ncodepage *p: nmaxindexlen *p: rowbackcolor *p: rowfill *p: rowfontbold *p: rowfontitalic *p: rowfontname *p: rowfontsize *p: rowforecolor *p: sheetfirstcol *p: sheetfirstrow *p: sheetname *a: aerrmess[7,0] *a: astyles[6,0] * PROTECTED lerror * autocolw = .F. Caption = "" cfields = ("") cfieldstotal = ("") cheaders = ("") grid = ("") headbackcolor = -1 headfill = .F. headfontbold = .T. headfontitalic = .F. headfontname = ("") headfontsize = 0 headforecolor = -1 Height = 15 label = ('') langid = EN lastcol = XFD lastrow = (1048576) lerror = .F. lfirst = .T. lhead = .T. lmemoascomment = .F. lopen = .T. Name = "exportxlsx" ncodepage = 0 nmaxindexlen = 60 rowbackcolor = -1 rowfill = .F. rowfontbold = .F. rowfontitalic = .F. rowfontname = ('') rowfontsize = 0 rowforecolor = -1 sheetfirstcol = A sheetfirstrow = 0 sheetname = sheet1 ToolTipText = "Export xlsx (Excel 2007+)" Width = 15 * PROCEDURE cleanup ********************** * For OS below Win 7 * ********************** LPARAMETERS lcDir,llMemoAsComment,llToClose,cCur,cTotal,cMax,cStrings,lcCurrAlias,lnFHSh,lnFHStr,lnFHCo,lnFHDr,lcOldPath LOCAL lSetSafety lSetSafety = SET("Safety") SET SAFETY OFF This.cleanup2(m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath) ERASE (ADDBS(ADDBS(m.lcDir+[xl])+[_rels]) + "*.*") RD (ADDBS(ADDBS(m.lcDir+[xl])+[_rels])) IF m.llMemoAsComment ERASE (ADDBS(ADDBS(m.lcDir+[xl])+[drawings]) + "*.*") RD (ADDBS(ADDBS(m.lcDir+[xl])+[drawings])) ERASE (ADDBS(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])+[_rels]) + "*.*") RD (ADDBS(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])+[_rels])) ENDIF ERASE (ADDBS(ADDBS(m.lcDir+[xl])+[worksheets]) + "*.*") RD (ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])) ERASE (ADDBS(m.lcDir+[xl]) + "*.*") RD (ADDBS(m.lcDir+[xl])) ERASE (ADDBS(m.lcDir+[docProps]) + "*.*") RD (ADDBS(m.lcDir+[docProps])) ERASE (ADDBS(m.lcDir+[_rels]) + "*.*") RD (ADDBS(m.lcDir+[_rels])) ERASE (m.lcDir + "*.*") RD (m.lcDir) SET SAFETY &lSetSafety ENDPROC PROCEDURE cleanup2 LPARAMETERS llToClose,cCur,cTotal,cMax,cStrings,lcCurrAlias,lnFHSh,lnFHStr,lnFHCo,lnFHDr,lcOldPath IF m.llToClose USE IN (m.cCur) ENDIF IF USED(m.cTotal) USE IN (m.cTotal) ENDIF IF USED(m.cMax) USE IN (m.cMax) ENDIF IF USED(m.cStrings) USE IN (m.cStrings) ENDIF IF !EMPTY(m.lcCurrAlias) SELECT (m.lcCurrAlias) ENDIF IF VARTYPE(m.lnFHSh) == "N" FCLOSE(m.lnFHSh) ENDIF IF VARTYPE(m.lnFHStr) == "N" FCLOSE(m.lnFHStr) ENDIF IF VARTYPE(m.lnFHCo) == "N" FCLOSE(m.lnFHCo) ENDIF IF VARTYPE(m.lnFHDr) == "N" FCLOSE(m.lnFHDr) ENDIF IF !EMPTY(m.lcOldPath) SET DEFAULT TO (m.lcOldPath) ENDIF ENDPROC PROCEDURE Click LOCAL lcFile,cCursor,llDo llDo = .F. * Courtesy of Tobias B LOCAL lc_FileName DO CASE CASE TYPE("THIS.Label") == "C" m.lc_FileName = THIS.Label + "_" CASE TYPE("THIS.Label.Caption") == "C" m.lc_FileName = THIS.Label.Caption + "_" OTHERWISE m.lc_FileName = "" ENDCASE lc_FileName = m.lc_FileName + TTOC(DATETIME(),1) + ".xlsx" IF VARTYPE(This.grid)="O" AND !ISNULL(This.grid) IF LOWER(This.grid.baseclass)!="grid" RETURN ENDIF lcFile=PUTFILE("File name",m.lc_FileName,"XLSX") cCursor=This.grid.RecordSource llDo = !EMPTY(m.lcFile) AND USED(m.cCursor) ENDIF IF VARTYPE(This.grid)="C" AND !EMPTY(This.grid) lcFile=PUTFILE("File name",m.lc_FileName,"XLSX") cCursor=This.grid llDo = !EMPTY(m.lcFile) AND USED(m.cCursor) ENDIF IF m.llDo This.TestProp This.Thefirsttime This.langSet This.copytoxlsx(m.cCursor,m.lcFile) ENDIF ENDPROC PROCEDURE copytoxlsx LPARAMETERS cCur,lcFileName # DEFINE MAXIMUMCOMMENTHEIGHT 20 && maximum height of a comment (expressed in sheet rows) # DEFINE MAXIMUMCOMMENTWIDTH 10 && maximum width of a comment (expressed in sheet columns) DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle,STRING cOperation,STRING cFileName,STRING cParameters,STRING cDirectory,INTEGER nShowWindow IF OS(3) < '6' && XP Declare INTEGER GetLocaleInfo in Win32API LONG Locale, LONG LCType, STRING @LpLCData, INTEGER cchData ELSE Declare INTEGER GetLocaleInfoEx in Win32API String Locale, LONG LCType, STRING @LpLCData, INTEGER cchData ENDIF DECLARE Sleep IN kernel32 INTEGER LOCAL lcMyPath,lcDir,loerr as Exception LOCAL lnRowsNo,lnColsNo,laFields[1,6],lnCurRow,lnCurCol,lnTime,ltTime,lcSetDec,lnColsNoAll,laFieldsAll[1],lnLenStr,lnLenIdx,llMemos,lnII,lSetTalk,lnFFields,laFFields[1] LOCAL cStrings,lnColChars,llCR,lcValue,lnDec,cMax,ldValue LOCAL lcCurr,lcFFields LOCAL ldDat01,ldDat11,ldDat02,ldDat12,ldDat03,ltDat02 LOCAL lnFHStr,lnFHSh,lcLenStr,lcLenIdx,lnCountbefore,lcUnion,lcField,lnTotal,cTotal,lcCurRow,ofile,lcSource,lcZipFileName,oShell,oFolder LOCAL lcStH,lcStN,lcStD,lcStT,lcStM,lcStC,llBelow7 LOCAL lnHead,laHead[1],llHead,lnsheetfirstcol,lni,lcRowHeight,lcFontName,lnFontSize,lnColWidth,lnNoRows,lcProcName,lcProcCode LOCAL laFields[1,7],lnType,lala[1],lcSetPoint,llMemoAsComment,lnFHCo,lnFHDr,lnCurComm,lnNoRow,laNoRow[1],lniNoRow,lnMaxLenRow,lnCommW,lnCommH LOCAL lcCurrAlias,llToClose,lcOldPath,lnCodePage,lcCodePage,lcStrBad,lcTmp,lnj lcStrBad = '' FOR lni = 0 TO 31 IF !INLIST(m.lni,9,10,13) lcStrBad = m.lcStrBad + CHR(m.lni) ENDIF NEXT lcCurrAlias = ALIAS() llToClose = .F. llMemoAsComment = This.lMemoAsComment IF PCOUNT() < 1 MESSAGEBOX(This.aErrMess[4],48,This.aErrMess[3]) RETURN ELSE IF VARTYPE(m.cCur) $ "CV" IF !USED(m.cCur) USE (m.cCur) IN 0 llToClose = .T. ENDIF ELSE MESSAGEBOX(This.aErrMess[5],48,This.aErrMess[3]) RETURN ENDIF ENDIF IF PCOUNT() < 2 lcFileName = FORCEEXT(SYS(2015),"xlsx") ELSE IF VARTYPE(m.lcFileName) $ "CV" lcFileName = FORCEEXT(m.lcFileName,"xlsx") ELSE lcFileName = FORCEEXT(SYS(2015),"xlsx") ENDIF ENDIF * Thanks to Gregory Green IF VARTYPE(This.nCodePage) <> "N" lcCodePage = '' ELSE IF !INLIST(This.nCodePage,437,620,737,850,852,857,861,865,866,874,895,932,936,949,950,1250,1251,1252,1253,1254,1255,1256) lcCodePage = '' ELSE lcCodePage = 'CODEPAGE = ' + TRANSFORM(This.nCodePage) ENDIF ENDIF ******** llHead = This.lHead lcFFields = This.cFields IF m.llHead AND !EMPTY(This.cHeaders) lnHead = ALINES(laHead,This.cHeaders,4,",") ELSE lnHead = 0 ENDIF IF FILE(FORCEEXT(m.lcFileName,"xlsx")) IF MESSAGEBOX(FORCEEXT(m.lcFileName,"xlsx")+" "+This.aErrMess[6]+CHR(13)+This.aErrMess[7],4+48,This.aErrMess[3]) = 7 RETURN ELSE ERASE (FORCEEXT(m.lcFileName,"xlsx")) RECYCLE ENDIF ENDIF lnFFields = 0 IF VARTYPE(m.lcFFields) <> "C" lcFFields = "" ELSE lnFFields = ALINES(laFFields,UPPER(m.lcFFields),1+4,",") ENDIF lSetTalk = SET("Talk") SET TALK OFF lcSetPoint = SET("Point") SET POINT TO "." lnColsNoAll=AFIELDS(m.laFieldsAll,m.cCur) lnColsNo = 0 lnLenStr = 19 && for datetime llMemos = .F. lcUnion = "" cTotal = SYS(2015) lnTotal = 0 ldDat01 = DATE(1900,3,1) ldDat02 = DATE(1900,1,1) ldDat03 = DATE(1900,2,28) ldDat11 = m.ldDat01 - 61 ldDat12 = m.ldDat02 - 1 ltDat02 = DATETIME(1900,1,1,0,0,0) lnColChars = 0 lnsheetfirstcol = 0 FOR lni = 1 TO LEN(This.sheetfirstcol) lnsheetfirstcol = m.lnsheetfirstcol * 26 + ASC(SUBSTR(This.sheetfirstcol,m.lni,1)) - 64 NEXT LOCAL lnActualCol,lnActualField,lnActualField2 lnActualCol = 0 FOR lnCurCol = 1 TO m.lnColsNoAll lnActualCol = m.lnActualCol + 1 IF m.laFieldsAll[m.lnCurCol,2] $ "G" lnActualCol = m.lnActualCol - 1 FOR lnActualField = 1 TO m.lnFFields IF m.laFieldsAll[m.lnCurCol,1] == laFFields[m.lnActualField] FOR lnActualField2 = m.lnActualField TO m.lnFFields - 1 laFFields[m.lnActualField2] = m.laFFields[m.lnActualField2 + 1] NEXT lnFFields = m.lnFFields - 1 EXIT ENDIF NEXT ENDIF IF m.laFieldsAll[m.lnCurCol,2] $ "NFYBIDTLCVM" IF !EMPTY(m.lcFFields) IF ASCAN(m.laFFields,laFieldsAll[m.lnCurCol,1],1,-1,-1,1+2+4)=0 LOOP ENDIF ENDIF lnColsNo = m.lnColsNo + 1 DIMENSION laFields[m.lnColsNo,7] laFields[m.lnColsNo,1] = laFieldsAll[m.lnCurCol,1] laFields[m.lnColsNo,2] = IIF(laFieldsAll[m.lnCurCol,2] $ "CV",1,; IIF(laFieldsAll[m.lnCurCol,2] $ "NF",2,; IIF(laFieldsAll[m.lnCurCol,2] == "I",3,; IIF(laFieldsAll[m.lnCurCol,2] == "D",4,; IIF(laFieldsAll[m.lnCurCol,2] == "T",5,; IIF(laFieldsAll[m.lnCurCol,2] == "L",6,; IIF(laFieldsAll[m.lnCurCol,2] == "Y",7,; IIF(laFieldsAll[m.lnCurCol,2] == "B",8,; IIF(laFieldsAll[m.lnCurCol,2] == "M",9,10))))))))) laFields[m.lnColsNo,3] = laFieldsAll[m.lnCurCol,3] laFields[m.lnColsNo,4] = laFieldsAll[m.lnCurCol,4] laFields[m.lnColsNo,5] = IIF(m.lnColsNo + m.lnsheetfirstcol - 1 <=26,[],; IIF(m.lnColsNo + m.lnsheetfirstcol - 1 <=702,CHR(64 + FLOOR((m.lnColsNo + m.lnsheetfirstcol - 2) / 26)),; CHR(64 + FLOOR((m.lnColsNo + m.lnsheetfirstcol - 2 - 26) / 676))+CHR(65 + FLOOR(MOD(m.lnColsNo + m.lnsheetfirstcol - 2 - 26,676) / 26))))+; CHR(65 + MOD(m.lnColsNo + m.lnsheetfirstcol - 2,26)) laFields[m.lnColsNo,6] = laFieldsAll[m.lnCurCol,3] laFields[m.lnColsNo,7] = m.lnActualCol &&lnCurCol IF LEN(laFields[m.lnColsNo,5]) = 3 AND laFields[m.lnColsNo,5] = This.LastCol EXIT ENDIF ELSE LOOP ENDIF lcField = laFieldsAll[m.lnCurCol,1] IF m.laFieldsAll[m.lnCurCol,2] $ "CV" lnLenStr = MAX(m.lnLenStr, laFieldsAll[m.lnCurCol,3]) IF !EMPTY(m.lcUnion) lcUnion = m.lcUnion + " UNION" ENDIF lcUnion = m.lcUnion + " SELECT DISTINCT CAST(RTRIM(" + m.lcField + ") AS V("+TRANSFORM(m.laFieldsAll[m.lnCurCol,3])+")) FROM " + m.cCur + " WHERE !ISNULL(" + m.lcField + ")" SELECT COUNT(*) as no FROM (m.cCur) WHERE ISNULL(&lcField) INTO CURSOR (m.cTotal) lnTotal = m.lnTotal + RECCOUNT(m.cCur) - &cTotal..no IF This.autocolw SELECT CAST(MAX(LEN(RTRIM(&lcField))) as I) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal) laFields[m.lnColsNo,6] = &cTotal..maxw ENDIF ENDIF IF This.autocolw IF m.laFieldsAll[m.lnCurCol,2] $ "NF" SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal) laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,laFieldsAll[m.lnCurCol,3],laFieldsAll[m.lnCurCol,4])))+1 ENDIF IF m.laFieldsAll[m.lnCurCol,2] == "L" laFields[m.lnColsNo,6] = 5 ENDIF IF m.laFieldsAll[m.lnCurCol,2] == "I" SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal) laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,12)))+1 ENDIF IF m.laFieldsAll[m.lnCurCol,2] == "Y" SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal) laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,22,4)))+1 ENDIF IF m.laFieldsAll[m.lnCurCol,2] == "B" SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal) laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,22,laFieldsAll[m.lnCurCol,4])))+1 ENDIF ENDIF IF m.laFieldsAll[m.lnCurCol,2] == "D" IF !EMPTY(m.lcUnion) lcUnion = m.lcUnion + " UNION" ENDIF lcUnion = m.lcUnion + " SELECT DISTINCT DTOC(" + m.lcField + ") FROM " + m.cCur + " WHERE " + m.lcField + " < m.ldDat02 " SELECT COUNT(*) as no FROM (m.cCur) WHERE &lcField < m.ldDat02 INTO CURSOR (m.cTotal) lnTotal = m.lnTotal + &cTotal..no laFields[m.lnColsNo,6] = 10 ENDIF IF m.laFieldsAll[m.lnCurCol,2] == "T" IF !EMPTY(m.lcUnion) lcUnion = m.lcUnion + " UNION" ENDIF lcUnion = m.lcUnion + " SELECT DISTINCT TTOC(" + m.lcField + ") FROM " + m.cCur + " WHERE " + m.lcField + " < m.ltDat02 " SELECT COUNT(*) as no FROM (m.cCur) WHERE &lcField < m.ltDat02 INTO CURSOR (m.cTotal) lnTotal = m.lnTotal + &cTotal..no laFields[m.lnColsNo,6] = 19 ENDIF IF m.laFieldsAll[m.lnCurCol,2] == "M" lnColChars = m.lnColChars +1 llMemos = .T. IF This.autocolw IF m.llMemoAsComment laFields[m.lnColsNo,6] = 5 ELSE lcProcName = SYS(2015) TEXT TO m.lcProcCode TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 SELECT MAX(<>(<>)) as maxw FROM <> WHERE !ISNULL(<>) INTO CURSOR <> RETURN <>.maxw FUNCTION <> LPARAMETERS tcValue LOCAL lnRow,laRow[1],lnMax,lni IF EMPTY(m.tcValue) RETURN 0 ELSE lnRow = ALINES(laRow,m.tcValue,2) lnMax = LEN(m.laRow[1]) FOR lni = 2 TO m.lnRow lnMax = MAX(m.lnMax,LEN(m.laRow[m.lni])) NEXT RETURN m.lnMax ENDIF ENDFUNC ENDTEXT laFields[m.lnColsNo,6] = EXECSCRIPT(m.lcProcCode) ENDIF ENDIF ENDIF NEXT lnLenIdx = MIN(This.nMaxIndexLen, m.lnLenStr) lnTotal = m.lnTotal + m.lnColsNo SELECT (m.cCur) COUNT TO m.lnRowsNo lnTotal = m.lnTotal + m.lnRowsNo * m.lnColChars lnRowsNo=m.lnRowsNo+IIF(m.llHead,1,0) FOR lni = 1 TO m.lnFFields FOR lnCurCol = 1 TO m.lnColsNo IF m.laFields[m.lnCurCol,1] == m.laFFields[m.lni] FOR lnj = 1 TO ALEN(laFields,2) lcTmp = m.laFields[m.lnCurCol,m.lnj] laFields[m.lnCurCol,m.lnj] = m.laFields[m.lni,m.lnj] laFields[m.lni,m.lnj] = m.lcTmp NEXT EXIT ENDIF NEXT NEXT FOR lnCurCol = 1 TO m.lnColsNo laFields[m.lnCurCol,5] = IIF(m.lnCurCol + m.lnsheetfirstcol - 1 <=26,[],; IIF(m.lnCurCol + m.lnsheetfirstcol - 1 <=702,CHR(64 + FLOOR((m.lnCurCol + m.lnsheetfirstcol - 2) / 26)),; CHR(64 + FLOOR((m.lnCurCol + m.lnsheetfirstcol - 2 - 26) / 676))+CHR(65 + FLOOR(MOD(m.lnCurCol + m.lnsheetfirstcol - 2 - 26,676) / 26))))+; CHR(65 + MOD(m.lnCurCol + m.lnsheetfirstcol - 2,26)) NEXT cStrings = SYS(2015) cMax = SYS(2015) CREATE CURSOR (m.cStrings) &lcCodePage (ii I AUTOINC NEXTVALUE 0,cStr V(m.lnLenStr),cM M) IF m.llMemoAsComment and m.llMemos INSERT INTO (m.cStrings) (cStr) VALUES ("Memo") ENDIF IF !EMPTY(m.lcUnion) EXECSCRIPT("LPARAMETERS ldDat02,ltDat02"+CHR(13)+"INSERT INTO " + m.cStrings + " (cStr)" + m.lcUnion,m.ldDat02,m.ltDat02) ENDIF IF m.lnLenStr > 0 IF m.lnLenIdx >= m.lnLenStr INDEX on cStr TAG cStr ELSE lcLenIdx = LTRIM(STR(m.lnLenIdx)) INDEX on LEFT(cStr,&lcLenIdx) TAG cStr ENDIF ENDIF IF m.llMemos lcLenStr = LTRIM(STR(m.lnLenIdx)) && courtesy of Tobias B INDEX on LEFT(cM,&lcLenStr) TAG cM ENDIF SET ORDER TO cStr lcCurr = This.Getcurr(m.lcStrBad) && courtesy of Martina Jindrová lcOldPath = SYS(5)+SYS(2003) lcMyPath='' IF !EMPTY(JUSTPATH(m.lcFileName)) lcMyPath=ADDBS(JUSTPATH(m.lcFileName)) SET DEFAULT TO (m.lcMyPath) ELSE lcMyPath = ADDBS(JUSTPATH(FULLPATH(m.lcFileName))) ENDIF lcDir=This.gen_dirs(m.llMemoAsComment and m.llMemos) This.gen_Content_Types(m.lcDir,m.llMemoAsComment and m.llMemos) IF This.lError RETURN ENDIF This.gen_rels(ADDBS(m.lcDir+[_rels])) IF This.lError RETURN ENDIF This.gen_app(ADDBS(m.lcDir+[docProps])) IF This.lError RETURN ENDIF This.gen_core(ADDBS(m.lcDir+[docProps])) IF This.lError RETURN ENDIF This.gen_workbook(ADDBS(ADDBS(m.lcDir+[xl])+[_rels]),m.llMemoAsComment and m.llMemos) IF This.lError RETURN ENDIF This.gen_styles(ADDBS(m.lcDir+[xl]),m.lcCurr,m.llMemoAsComment and m.llMemos) IF This.lError RETURN ENDIF This.gen_workbook2(ADDBS(m.lcDir+[xl])) IF This.lError RETURN ENDIF IF m.llMemoAsComment and m.llMemos This.gen_workbook3(ADDBS(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])+[_rels])) ENDIF lcStH = [ s="]+LTRIM(STR(This.aStyles[6]))+["] lcStN = [ s="]+LTRIM(STR(This.aStyles[1]))+["] lcStD = [ s="]+LTRIM(STR(This.aStyles[2]))+["] lcStT = [ s="]+LTRIM(STR(This.aStyles[3]))+["] lcStM = [ s="]+LTRIM(STR(This.aStyles[4]))+["] lcStC = [ s="]+LTRIM(STR(This.aStyles[5]))+["] * Begin sheet1 lnFHSh = FCREATE(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets]) + [sheet1.xml]) IF m.lnFHSh < 0 MESSAGEBOX(This.aErrMess[2] + ' sheet1.xml',16,This.aErrMess[1]) This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath) RETURN ENDIF FWRITE(m.lnFHSh,[]+CHR(10)) FWRITE(m.lnFHSh,[ ]) FWRITE(m.lnFHSh,[]) FWRITE(m.lnFHSh,[]) FWRITE(m.lnFHSh,[]) IF This.autocolw FWRITE(m.lnFHSh,[]) FOR lnCurCol = 1 TO m.lnColsNo lcFontName = _screen.FontName lnFontSize = _screen.FontSize _screen.FontName = IIF(!EMPTY(This.rowFontName), This.rowFontName, "Calibri") _screen.FontSize = IIF(This.RowFontSize>0, This.RowFontSize, 11) lnColWidth = _screen.TextWidth(REPLICATE("A",m.laFields[m.lnCurCol,6])) / 75 * 10 + 0.7 _screen.FontName = m.lcFontName _screen.FontSize = m.lnFontSize FWRITE(m.lnFHSh,[]) NEXT FWRITE(m.lnFHSh,[]) ENDIF FWRITE(m.lnFHSh,[]) IF m.llMemoAsComment AND m.llMemos * Begin comments1 lnFHCo = FCREATE(ADDBS(m.lcDir+[xl])+"comments1.xml") IF m.lnFHCo < 0 MESSAGEBOX(This.aErrMess[2] + ' comments1.xml',16,This.aErrMess[1]) This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath) RETURN ENDIF FWRITE(m.lnFHCo,[]+CHR(10)) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[CopyToXlsx]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) * Begin vmlDrawing1.vml lnFHDr = FCREATE(ADDBS(ADDBS(m.lcDir+[xl])+[drawings])+"vmlDrawing1.vml") IF m.lnFHDr < 0 MESSAGEBOX(This.aErrMess[2] + ' vmlDrawing1.vml',16,This.aErrMess[1]) This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath) RETURN ENDIF FWRITE(m.lnFHDr,[]+CHR(10)) FWRITE(m.lnFHDr,[]) FWRITE(m.lnFHDr,[]) FWRITE(m.lnFHDr,[]) FWRITE(m.lnFHDr,[]) FWRITE(m.lnFHDr,[]) FWRITE(m.lnFHDr,[]) FWRITE(m.lnFHDr,[]) FWRITE(m.lnFHDr,[]) ENDIF * Begin sharedStrings lnFHStr = FCREATE(ADDBS(m.lcDir+[xl])+"sharedStrings.xml") IF m.lnFHStr < 0 MESSAGEBOX(This.aErrMess[2] + ' sharedStrings.xml',16,This.aErrMess[1]) This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath) RETURN ENDIF FWRITE(m.lnFHStr,[]+CHR(10)) FWRITE(m.lnFHStr,[0,[ customHeight="1" ht="] + LTRIM(STR(This.HeadFontSize * 1.275,10,2)) + ["],[])+ [>]) && spans="1:1" x14ac:dyDescent="0.25" FOR lnCurCol = 1 TO m.lnColsNo FWRITE(m.lnFHSh,[]+LTRIM(STR(m.lnII))+[]) ELSE FWRITE(m.lnFHStr,[]+This.htmspec(m.lcValue,m.lcStrBad)+[]) INSERT INTO (m.cStrings) (cStr) VALUES (m.lcValue) SELECT MAX(ii) as ii FROM (m.cStrings) INTO CURSOR (m.cMax) SELECT (m.cMax) lnII = ii FWRITE(m.lnFHSh,[" t="s"] + m.lcStH +[>]+LTRIM(STR(m.lnII))+[]) ENDIF NEXT FWRITE(m.lnFHSh,[]+CHR(10)) ENDIF lcRowHeight = IIF(This.RowFontSize>0,[ customHeight="1" ht="] + LTRIM(STR(This.RowFontSize * 1.275,10,2)) + ["],[]) lcSetDec = SET("Decimals") SET DECIMALS TO 13 IF m.llMemoAsComment AND m.llMemos lnCurComm = 0 ENDIF SELECT (m.cCur) DO CASE CASE m.llMemos AND m.lnLenIdx < m.lnLenStr SCAN lnCurRow = m.lnCurRow + 1 IF m.lnCurRow > This.LastRow EXIT ENDIF lcCurRow = LTRIM(STR(m.lnCurRow)) SCATTER MEMO TO lala lnNoRows = 1 FOR lnCurCol = 1 TO m.lnColsNo IF m.laFields[m.lnCurCol,2] = 9 lnNoRows = MAX(m.lnNoRows , 1 + OCCURS(CHR(13),RTRIM(lala[m.laFields[m.lnCurCol,7]]))) ENDIF NEXT lcRowHeight = [ customHeight="1" ht="] + LTRIM(STR(IIF(This.RowFontSize>0,This.RowFontSize,11) * m.lnNoRows * 1.275,10,2)) + ["] FWRITE(m.lnFHSh,[]) FOR lnCurCol = 1 TO m.lnColsNo SET ORDER TO cStr IN (m.cStrings) lcValue = lala[m.laFields[m.lnCurCol,7]] IF ISNULL(m.lcValue) LOOP ENDIF lnType = m.laFields[m.lnCurCol,2] lnDec = m.laFields[m.lnCurCol,4] FWRITE(m.lnFHSh,[]) && Empty cell ELSE SELECT (m.cStrings) SET KEY TO LEFT(m.lcValue,m.lnLenIdx) SCAN IF cStr == m.lcValue EXIT ENDIF ENDSCAN SET KEY TO FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[>]+LTRIM(STR(II))+[]) ENDIF SELECT (m.cCur) ELSE IF m.lnType == 2 FWRITE(m.lnFHSh,["] + m.lcStN +[>]+LTRIM(STR(m.lcValue,m.laFields[m.lnCurCol,3],m.lnDec))+[]) ELSE IF m.lnType == 3 FWRITE(m.lnFHSh,["] + m.lcStN +[>]+LTRIM(STR(m.lcValue))+[]) ELSE IF m.lnType == 4 IF EMPTY(m.lcValue) FWRITE(m.lnFHSh,[">]) && Empty cell ELSE IF m.lcValue >= m.ldDat01 FWRITE(m.lnFHSh,["] + m.lcStD +[>]+LTRIM(STR(m.lcValue - m.ldDat11))+[]) ELSE IF BETWEEN(m.lcValue,m.ldDat02,m.ldDat03) FWRITE(m.lnFHSh,["] + m.lcStD +[>]+LTRIM(STR(m.lcValue - m.ldDat12))+[]) ELSE lcValue = DTOC(m.lcValue) SELECT (m.cStrings) SET KEY TO LEFT(m.lcValue,m.lnLenIdx) SCAN IF cStr == m.lcValue EXIT ENDIF ENDSCAN SET KEY TO FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[>]+LTRIM(STR(II))+[]) SELECT (m.cCur) ENDIF ENDIF ENDIF ELSE IF m.lnType == 5 IF EMPTY(m.lcValue) FWRITE(m.lnFHSh,[">]) && Empty cell ELSE ltTime = m.lcValue ldValue = TTOD(m.lcValue) lnTime = (m.ltTime-DATETIME(YEAR(m.ltTime),MONTH(m.ltTime),DAY(m.ltTime),0,0,0))/(86400.0) IF m.ldValue >= m.ldDat01 FWRITE(m.lnFHSh,["] + m.lcStT +[>]+LTRIM(STR(m.ldValue - m.ldDat11))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[]) ELSE IF BETWEEN(m.ldValue,m.ldDat02,m.ldDat03) FWRITE(m.lnFHSh,["] + m.lcStT +[>]+LTRIM(STR(m.ldValue - m.ldDat12))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[]) ELSE lcValue = TTOC(m.lcValue) SELECT (m.cStrings) SET KEY TO LEFT(m.lcValue,m.lnLenIdx) SCAN IF cStr == m.lcValue EXIT ENDIF ENDSCAN SET KEY TO FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[>]+LTRIM(STR(II))+[]) SELECT (m.cCur) ENDIF ENDIF ENDIF ELSE IF m.lnType == 6 FWRITE(m.lnFHSh,[" t="b"] + m.lcStN +[>]+IIF(m.lcValue ,[1],[0])+[]) ELSE IF m.lnType == 7 FWRITE(m.lnFHSh,["] + m.lcStC +[>]+LTRIM(STR(m.lcValue,21,4))+[]) ELSE IF m.lnType == 8 FWRITE(m.lnFHSh,["] + m.lcStN +[>]+LTRIM(STR(m.lcValue,21,m.lnDec))+[]) ELSE IF m.lnType == 9 lcValue = RTRIM(m.lcValue) IF m.llMemoAsComment lnCurComm = m.lnCurComm + 1 IF EMPTY(m.lcValue) FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s">]) && Empty cell ELSE FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s">0]) && Type "Memo" in sheet1 FWRITE(m.lnFHCo,[]) && comments1 FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[] + m.lcValue + []) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHCo,[]) FWRITE(m.lnFHDr,[