This is because some of the MS Active X controls need a developer license, otherwise the CREATEOBJECT() doesn't work. An easy workaround is to add the Active X to a form or form class and make calls to the Active X controls on this form. The license information is stored in the Registry in this key: HKEY_CLASSES_ROOT\Licenses. It'll probably work fine if you add the license info to your customer's registry. It just takes a little while to identify the correct license code for your the Active X control. Also, it is important to take note of the default value in the HKEY_CLASSES_ROOT\Licenses key:
Licensing: Copying the keys may be a violation of established copyrights.
Read more about it in the MSKB.
INFO: OLE Control Licensing in Visual FoxPro
http://support.microsoft.com/default.aspx?scid=KB;en-us;139154
I ran into a similar problem trying to use MSCOMM32.OCX on a client's machine. I searched for a fix in Microsoft's KB and found Microsoft Knowledge Base Article - 192693. Check it out at http://support.microsoft.com/default.aspx?scid=kb;EN-US;192693. Their suggestion is to subclass the control and instantiate the subclass. Worked for me.
miercuri, 12 mai 2010
(VFP) Inregistrari DUBLE tabela
SELECT * FROM myTable UNION SELECT * FROM myTable
OR
SELECT account_id FROM customer GROUP BY account_id ;
HAVING COUNT(account_id) > 1
OR
SELECT first_name + last_name AS cust_name ;
FROM customer GROUP BY first_name + last_name ;
HAVING COUNT(first_name + last_name) > 1
OR
SELECT * FROM customer WHERE account_id IN ;
(SELECT account_id FROM customer GROUP BY account_id ;
HAVING COUNT(account_id) > 1)
OR
SELECT * FROM myTable WHERE myField IN ;
(SELECT myField FROM myTable ;
GROUP by myField HAVING COUNT(myField) > 1);
INTO CURSOR myDuplicates
OR
SELECT account_id FROM customer GROUP BY account_id ;
HAVING COUNT(account_id) > 1
OR
SELECT first_name + last_name AS cust_name ;
FROM customer GROUP BY first_name + last_name ;
HAVING COUNT(first_name + last_name) > 1
OR
SELECT * FROM customer WHERE account_id IN ;
(SELECT account_id FROM customer GROUP BY account_id ;
HAVING COUNT(account_id) > 1)
OR
SELECT * FROM myTable WHERE myField IN ;
(SELECT myField FROM myTable ;
GROUP by myField HAVING COUNT(myField) > 1);
INTO CURSOR myDuplicates
(VFP) - How To Calling Store Procedure From VFP
USING SQL SERVER:
=======================
MYSTS = "EXECUTE MYQUE"
SQLEXEC(1, MYSTS, "MYCURSOR")
USING MYSQL:
=================
MYSTS = "CALL MYQUE();"
SQLEXEC(1, MYSTS, "MYCURSOR")
=======================
MYSTS = "EXECUTE MYQUE"
SQLEXEC(1, MYSTS, "MYCURSOR")
USING MYSQL:
=================
MYSTS = "CALL MYQUE();"
SQLEXEC(1, MYSTS, "MYCURSOR")
Configuring SQL Server authentication for MSDE and MS SQL Server
By default, when you install MSDE it is configured to support Windows authentication only. Windows authentication is usually not appropriate for web applications such as Enterprise Server, so you will have to override the default installation settings. Additionally, the setup program for MSDE has a bug, so even if you run the MSDE setup program with the parameter SECURITYMODE=SQL it will ignore this parameter and leave the security mode set to Windows Authentication only. As such, once you have installed MSDE, you will have to manually change the security mode for the MSDE Server by making some changes to the windows registry.
The following is a brief description of this process. For further information, refer to http://support.microsoft.com/kb/Q322336/EN-US/
I. Manually changing the authentication settings for SQL Server 2005 and SQL Server 2005 Express servers
You can change the Authentication mode on existing MSDE Servers by modifying a value in the windows registry, as follows:
1.Run the registry editor (Select Start | Run from the windows start menu, type regedit and then click OK).
2.Locate the key HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\MSSQL.x\MSSQLServer
(Note If you are using SQL Server 2005, the above registry key is used to store the authentication mode regardless of whether you installed a default instance or a named instance. MSSQL.x is a placeholder for the corresponding value for your system).
3.Set the value LoginMode to 2. This tells your server to accept SQL Server & Windows authentication methods.
4.Make sure to stop and restart the MSSQL service after making this change. You can do this by executing the two following commands from the command prompt
NET STOP MSSQLSERVER
NET START MSSQLSERVER
II. Manually changing the authentication settings for SQL Server 2000 and MSDE 2000 servers
You can change the Authentication mode on existing MSDE Servers by modifying a value in the windows registry, as follows:
1.Run the registry editor (Select Start | Run from the windows start menu, type regedit and then click OK).
2.Set the value HKLM\Software\Microsoft\MSSqlserver\MSSqlServer\LoginMode to 2. This tells your server to accept SQL Server & Windows authentication methods.
(Note: If you used a Named Instance when you installed MSDE, then the key will be HKLM\Software\Microsoft\Microsoft SQL Server\Instance Name\MSSqlserver\LoginMode).
3.Make sure to stop and restart the MSSQL service after making this change. You can do this by executing the two following commands from the command prompt
NET STOP MSSQLSERVER
NET START MSSQLSERVER
The following is a brief description of this process. For further information, refer to http://support.microsoft.com/kb/Q322336/EN-US/
I. Manually changing the authentication settings for SQL Server 2005 and SQL Server 2005 Express servers
You can change the Authentication mode on existing MSDE Servers by modifying a value in the windows registry, as follows:
1.Run the registry editor (Select Start | Run from the windows start menu, type regedit and then click OK).
2.Locate the key HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\MSSQL.x\MSSQLServer
(Note If you are using SQL Server 2005, the above registry key is used to store the authentication mode regardless of whether you installed a default instance or a named instance. MSSQL.x is a placeholder for the corresponding value for your system).
3.Set the value LoginMode to 2. This tells your server to accept SQL Server & Windows authentication methods.
4.Make sure to stop and restart the MSSQL service after making this change. You can do this by executing the two following commands from the command prompt
NET STOP MSSQLSERVER
NET START MSSQLSERVER
II. Manually changing the authentication settings for SQL Server 2000 and MSDE 2000 servers
You can change the Authentication mode on existing MSDE Servers by modifying a value in the windows registry, as follows:
1.Run the registry editor (Select Start | Run from the windows start menu, type regedit and then click OK).
2.Set the value HKLM\Software\Microsoft\MSSqlserver\MSSqlServer\LoginMode to 2. This tells your server to accept SQL Server & Windows authentication methods.
(Note: If you used a Named Instance when you installed MSDE, then the key will be HKLM\Software\Microsoft\Microsoft SQL Server\Instance Name\MSSqlserver\LoginMode).
3.Make sure to stop and restart the MSSQL service after making this change. You can do this by executing the two following commands from the command prompt
NET STOP MSSQLSERVER
NET START MSSQLSERVER
How to Change MSDE 'sa' password
Change your MSSQL Server or MSDE password for 'sa' login
C:\osql -U sa
1>sp_password NULL,'new_password','sa'
2>go
3>quit
C:\osql -U sa
1>sp_password NULL,'new_password','sa'
2>go
3>quit
Fix Generic Host For Win32 and Svchost.exe Error
Now we no longer have to worry about “Generic Host for Win32 Process” and “svchost.exe” errors that haunt our Windows XP almost daily (If not cured). Below i will explain what are the symptoms of this evil problem and how easily it can be fixed:
Symptoms:
You are surfing the internet or are engaged any type of Internet activity when suddenly all your Network activity goes to hault. You can still see the Internet connected icon in the tray but you cannot surf, browse or do anything.
You get an error message something like “Generic Host Process for Win32 Services has encountered a problem and needs to close. We are sorry for the inconvenience.”
Error message reporting about faulting netapi32.dll and svchost.exe.
You try to disconnect your Internet because of no activity observed but the Internet icon wont disappear.
You recieve an error message something like “Your PC has recovered from a serious problem” etc.
Solution:
Follow these simple steps and your Windows will be fully cured of this menace
Close Port 445:
1. Start Registry Editor (Regedit.exe) by clicking Start menu, and then click the Run icon.
2. In the small box that Opens, type: regedit then click the OK button. The Registry Editor will now have opened.
3. Locate the following key in the registry:
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\NetBT\Parameters
In the right-hand side of the window find an option called TransportBindName.
Double click that value, and then delete the default value, thus giving it a blank value.
Close Port 135:
1. Then you must now navigate to the following registry key:
HKEY_LOCAL_MACHINE\Software\Microsoft\OLE
2. You will see there is a String Value called: EnableDCOM
Set the value to: N (it should currently be Y)
3. Close the Registry Editor. Shutdown and Restart your computer.
Well thats all but if you want you can disable NETbios.
Symptoms:
You are surfing the internet or are engaged any type of Internet activity when suddenly all your Network activity goes to hault. You can still see the Internet connected icon in the tray but you cannot surf, browse or do anything.
You get an error message something like “Generic Host Process for Win32 Services has encountered a problem and needs to close. We are sorry for the inconvenience.”
Error message reporting about faulting netapi32.dll and svchost.exe.
You try to disconnect your Internet because of no activity observed but the Internet icon wont disappear.
You recieve an error message something like “Your PC has recovered from a serious problem” etc.
Solution:
Follow these simple steps and your Windows will be fully cured of this menace
Close Port 445:
1. Start Registry Editor (Regedit.exe) by clicking Start menu, and then click the Run icon.
2. In the small box that Opens, type: regedit then click the OK button. The Registry Editor will now have opened.
3. Locate the following key in the registry:
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\NetBT\Parameters
In the right-hand side of the window find an option called TransportBindName.
Double click that value, and then delete the default value, thus giving it a blank value.
Close Port 135:
1. Then you must now navigate to the following registry key:
HKEY_LOCAL_MACHINE\Software\Microsoft\OLE
2. You will see there is a String Value called: EnableDCOM
Set the value to: N (it should currently be Y)
3. Close the Registry Editor. Shutdown and Restart your computer.
Well thats all but if you want you can disable NETbios.
marți, 6 aprilie 2010
Visual FoxPro Grid2Xls
Cum se poate exporta Grid VFP in Excel?
SELECT cFacturiTotal
op = NEWOBJECT('Collection')
op.ADD(NEWOBJECT('Empty'),'headers') &&headers item, empty class
ADDPROPERTY(op.ITEM(1),'aHeaders[3,8]',.F.) &&aHeaders, array property, 8 columns
WITH op.ITEM(1)
* 1st header
.aheaders[1,1] = mHeader
.aheaders[1,2] = 1 &&row
.aheaders[1,3] = 2 &&column
.aheaders[1,4] = 'Arial' &&FontName
.aheaders[1,5] = 6 &&FontSize
.aheaders[1,6] = .T. &&FontBold
.aheaders[1,7] = .T. &&FontItalic
*2nd header
.aheaders[2,1] = mTitlu
.aheaders[2,2] = 2 &&row
.aheaders[2,3] = 2 &&column
.aheaders[2,4] = 'Arial' &&FontName
.aheaders[2,5] = 12 &&FontSize
.aheaders[2,6] = .T. &&FontBold
.aheaders[2,7] = .F. &&FontItalic
.aheaders[2,8] = -4108 &&Alignment ( xlCenter )
*3nd header
.aheaders[3,1] = mPerioada
.aheaders[3,2] = 3 &&row
.aheaders[3,3] = 2 &&column
.aheaders[3,4] = 'Arial' &&FontName
*.aheaders[3,5] = 16 &&FontSize
.aheaders[3,6] = .T. &&FontBold
.aheaders[3,7] = .F. &&FontItalic
.aheaders[3,8] = -4108 &&Alignment ( xlCenter )
ENDWITH
ADDPROPERTY(oP,'subtotals','11,3,4,5,6,7,8,9,10')
* first value ( 11 ) : group by column
* next values (3,4,5,6,7,8,9,10) : summed columns
Grid2Xls( THis.Parent.Grid1, op, 'cFacturiTotal', 2 )
Sursa PRG Gris2Xls:
PROCEDURE grid2xls
LPARAMETERS ogrid, oparameters , xrap, nHeaderObject
IF PCOUNT()< 4
nHeaderObject = 1
ENDI
*!* Program: grid2xls
*!* Author: Dorin Vasilescu
*!* Copyright: freeware
*!* Description: save table/cursor data to Excel using a grid as reference
* ( data ,columns, formatting, headers, DynamicBackColor)
*
* Parameters:
* oGrid: grid reference
* oParameters parameters objects, collection class, used to pass header rows, SaveAs file name, Subtotals
*
*Example:
* - headers:
* oP = NEWOBJECT('Collection')
* oP.Add(NEWOBJECT('Empty'),'headers') &&headers item, empty class
* AddProperty(oP.Item(1),'aHeaders[2,8]',.f.) &&aHeaders, array property, 8 columns
* WITH oP.Item(1)
* * 1st header
* .aHeaders[1,1] = 'Header 1 text:'
* .aHeaders[1,2] = 1 &&row
* .aHeaders[1,3] = 1 &&column
* .aHeaders[1,4] = 'Arial' &&FontName
* .aHeaders[1,5] = 16 &&FontSize
* .aHeaders[1,6] = .T. &&FontBold
* .aHeaders[1,7] = .T. &&FontItalic
* *2nd header
* .aHeaders[2,1] = 'Header 2 text'
* .aHeaders[2,2] = 4 &&row
* .aHeaders[2,3] = 4 &&column
* .aHeaders[2,8] = -4108 &&Alignment ( xlCenter )
* ENDWITH
*
* - SaveAs filename
*
* ADDPROPERTY(oP,'fileName','C:\Windows\Temp\test.xls')
*
*
* - subtotals (using comma delimited values)
*
* ADDPROPERTY(oP,'subtotals','1,3,4,5')
*
* first value ( 1 ) : group by column
* next values (3,4,5) : summed columns
*
*
* Call : grid2xls( oGrid, oP )
*
* OR : grid2xls( oGrid )
#DEFINE xlleft -4131
#DEFINE xlcenter -4108
#DEFINE xlright -4152
#DEFINE xlsum -4157
#DEFINE pixel_per_unit 7.5
#DEFINE msg_rows_processed "Inregistrari exportate: "
#IF .F.
LOCAL ogrid AS GRID
LOCAL oparameters AS COLLECTION
#ENDIF
LOCAL oexcel AS 'Excel.Application'
oexcel = .NULL.
TRY
oexcel = CREATEOBJECT('Excel.Application')
CATCH
MESSAGEBOX('Eroare initializare Excel.' + CHR(13) + 'Posibil neinstalat' , 0+16+4096 , 'Start Excel', 10000)
ENDTRY
*check if we continue or not
IF ISNULL(oexcel)
RETURN
ENDIF
IF NOT VARTYPE(ogrid) = 'O'
RETURN
ELSE
IF NOT ogrid.BASECLASS == 'Grid'
RETURN
ENDIF
ENDIF
LOCAL i, iitem, nfirstdatarow, nrowsprocessed, lhasparams, nheaderrow, oparmobj, ocolumn, lhasrap
LOCAL chditem, nrow, ncolumn, nrecno, crange, ndbcolor, ndfcolor, ocell
LOCAL ocols &&columns collection, needed to sort by ColumnOrder
nheaderrow = 1
nfirstdatarow = 2
nrowsprocessed = 0
lhasparams = (TYPE('oParameters') = 'O')
lhasrap = (TYPE('xrap') = 'C')
ocols = NEWOBJECT('Collection')
ocols.KEYSORT = 2
IF ogrid.RECORDSOURCETYPE = 1
SELECT (ogrid.RECORDSOURCE)
ELSE
*alias needed to be selected before calling
ENDIF
nrecno = RECNO()
*add columns ref to columns collection
FOR i = 1 TO ogrid.COLUMNCOUNT
*WAIT WINDOW ogrid.COLUMNS(i).controlsource
ocols.ADD(ogrid.COLUMNS(i), PADL(STR(i,3),3,'0'))
ENDFOR
*SUSPEND
oexcel.displayalerts = .F.
oexcel.screenupdating = .F.
*oexcel.workbooks.ADD
obook = oexcel.workbooks.ADD()
FOR i=2 TO oexcel.sheets.COUNT
oexcel.sheets(2).DELETE
ENDFOR
*set columns width/font
i = 0
FOR EACH ocolumn IN ocols
i = i + 1
WITH ocolumn
oexcel.COLUMNS(i).FONT.NAME = .FONTNAME
oexcel.COLUMNS(i).FONT.SIZE = .FONTSIZE
oexcel.COLUMNS(i).FONT.bold = .FONTBOLD
oexcel.COLUMNS(i).COLUMNWIDTH = (.WIDTH + 2*.PARENT.GRIDLINEWIDTH) / pixel_per_unit
ENDWITH
ENDFOR
IF lhasparams
IF PEMSTATUS(oparameters,'GetKey',5)
iitem = oparameters.GETKEY('headers')
ELSE
iitem = 0
ENDIF
IF iitem <> 0
oparamobj = oparameters.ITEM(iitem)
ENDIF
IF TYPE('oParamObj.aHeaders[1,1]') <> 'U'
WITH oparamobj
FOR i=1 TO ALEN(.aheaders,1)
*verify header item type
IF TYPE('.aHeaders[i,1]') = 'L'
chditem = ''
ELSE
chditem = .aheaders[i,1]
ENDIF
*verify header item row location type
IF TYPE('.aHeaders[i,2]') <> 'N'
nrow = i
ELSE
nrow = .aheaders[i,2]
ENDIF
*verify header item column location type
IF TYPE('.aHeaders[i,3]') <> 'N'
ncolumn = 1
ELSE
ncolumn = .aheaders[i,3]
ENDIF
*set header size, if necessary
IF nfirstdatarow < nrow + 2
nfirstdatarow = nrow + 2
ENDIF
oexcel.cells(nrow,ncolumn).SELECT
oexcel.SELECTION.VALUE = chditem
IF TYPE('.aHeaders[i,4]') = 'C'
oexcel.SELECTION.FONT.NAME = .aheaders[i,4]
ENDIF
IF TYPE('.aHeaders[i,5]') = 'N'
oexcel.SELECTION.FONT.SIZE = .aheaders[i,5]
ENDIF
oexcel.SELECTION.FONT.bold = .aheaders[i,6]
oexcel.SELECTION.FONT.italic = .aheaders[i,7]
IF TYPE('.aHeaders[i,8]') = 'N'
oexcel.SELECTION.horizontalalignment = .aheaders[i,8]
ENDIF
ENDFOR
ENDWITH
ENDIF
ENDIF
*Column Headers
nheaderrow = nfirstdatarow - 1
i = 0
FOR EACH ocolumn IN ocols
i = i + 1
oexcel.ROWS(nheaderrow).ROWHEIGHT = ogrid.HEADERHEIGHT
WITH ocolumn
oexcel.cells(nheaderrow,i).SELECT
oexcel.SELECTION.VALUE = .OBJECTS(nHeaderObject).CAPTION
oexcel.SELECTION.horizontalalignment = xlcenter
oexcel.SELECTION.verticalalignment = xlcenter
oexcel.SELECTION.wraptext = .T.
oexcel.COLUMNS(i).COLUMNWIDTH = .WIDTH / pixel_per_unit
ENDWITH
ENDFOR
WAIT WINDOW msg_rows_processed + STR( nrowsprocessed ) NOWAIT
SCAN
i = 0
FOR EACH ocolumn IN ocols
i = i + 1
WITH ocolumn
IF NOT EMPTY(.CONTROLSOURCE)
ocell = oexcel.cells(nfirstdatarow + nrowsprocessed, i)
IF NOT EMPTY(EVALUATE(.CONTROLSOURCE)) OR TYPE(.CONTROLSOURCE) = 'N'
ocell.VALUE = EVALUATE(.CONTROLSOURCE)
ENDIF
IF NOT EMPTY(.DYNAMICBACKCOLOR)
ndbcolor = EVALUATE(.DYNAMICBACKCOLOR)
IF ndbcolor <> ogrid.BACKCOLOR
ocell.interior.COLOR = ndbcolor
ENDIF
ENDIF
IF NOT EMPTY(.DYNAMICFORECOLOR)
ndfcolor = EVALUATE(.DYNAMICFORECOLOR)
IF ndfcolor <> ogrid.FORECOLOR
ocell.FONT.COLOR = ndfcolor
ENDIF
ENDIF
ctype = TYPE(.CONTROLSOURCE)
DO CASE
CASE ctype = 'C'
ocell.HorizontalAlignment = 2
OTHERWISE
ocell.HorizontalAlignment = 1
ENDC
ENDIF
ENDWITH
ENDFOR
nrowsprocessed = nrowsprocessed + 1
IF MOD(nrowsprocessed,SET("Odometer")) = 0
WAIT WINDOW msg_rows_processed + STR( nrowsprocessed ) NOWAIT
ENDIF
ENDSCAN
IF ogrid.COLUMNCOUNT <= 26
crange = 'A'+TRANSFORM(nheaderrow) + ':' + CHR(64+ogrid.COLUMNCOUNT) ;
+ TRANSFORM(nheaderrow + nrowsprocessed )
ELSE
crange = 'A'+TRANSFORM(nheaderrow ) + ':' ;
+ CHR(64+FLOOR(ogrid.COLUMNCOUNT/26)-1) ;
+ CHR(64+IIF(MOD(ogrid.COLUMNCOUNT,26)=0,26,MOD(ogrid.COLUMNCOUNT,26))) ;
+ TRANSFORM(nheaderrow + nrowsprocessed )
ENDIF
oexcel.RANGE(crange).SELECT
oexcel.SELECTION.BORDERS(1).linestyle = 1
oexcel.SELECTION.BORDERS(2).linestyle = 1
oexcel.SELECTION.BORDERS(3).linestyle = 1
oexcel.SELECTION.BORDERS(4).linestyle = 1
oexcel.activesheet.pagesetup.printtitlerows = "$1:$" + TRANSFORM(nheaderrow)
*subtotals, if needed, transmitted as comma delimited integers, first is group by column from 2nd, summed columns
IF lhasparams AND TYPE('oParameters.subTotals') = 'C'
LOCAL ARRAY atemp1[1], atemp2[1]
LOCAL igroupcount, igroupcolumn
igroupcount = ALINES(atemp,oparameters.subtotals,1,[,])
IF igroupcount > 1
FOR i = 1 TO igroupcount
atemp[i] = INT(VAL(atemp[i]))
ENDFOR
igroupcolumn = atemp[1]
ADEL(atemp,1)
DIMENSION atemp[iGroupCount - 1]
oexcel.SELECTION.subtotal(igroupcolumn, xlsum, @atemp, .T., .F., .T.)
ENDIF
ENDIF
IF lhasparams AND TYPE('oParameters.fileName') = 'C'
oexcel.activesheet.SAVEAS(oparameters.filename)
ENDIF
IF nrecno > 0 AND nrecno <= RECCOUNT()
GOTO nrecno
ENDIF
osheet = obook.activesheet
WITH oexcel
*WITH .worksheets(1)
* .COLUMNS.AUTOFIT
* .ROWS.AUTOFIT
*ENDWITH
WITH .activesheet
*OS=oexcel.activesheet && Daca faci asa va functiona IntelliSense in VFP ...
.pagesetup.ORIENTATION= 2 && xlLandscape
.pagesetup.topmargin=5
.pagesetup.bottommargin=5
.pagesetup.leftmargin=31
.pagesetup.rightmargin=2
lnpaperorientation = .pagesetup.ORIENTATION
DO CASE
CASE lnpaperorientation = 2
lnpapersize = 1
lnprintorientation = 2
CASE lnpaperorientation = 3
lnpapersize = 5
lnprintorientation = 1
CASE lnpaperorientation = 4
lnpapersize = 5
lnprintorientation = 2
OTHERWISE
lnpapersize = 1
lnprintorientation = 1
ENDCASE
lctotalrangeexpr = ["A1:] + columnletter(FCOUNT()) + ALLTRIM(STR(RECCOUNT() + 6)) + ["]
lctotalprintarea = ["$A$1:$] + columnletter(FCOUNT()) + [$]+ALLTRIM(STR(RECCOUNT() + 6)) + ["]
oexcelsheet = osheet
oexcelsheet.cells.SELECT
oexcelsheet.cells.entirecolumn.AUTOFIT
oexcelsheet.RANGE(&lctotalrangeexpr.).SELECT
WITH oexcelsheet.pagesetup
*!* This area sets to Title Rows of the spreadsheet that will be printed *!*
*!* on each page. Since this example contains the table field names on *!*
*!* the top row, and then an empty row of cells that was inserted by this *!*
*!* program, then we will set row 1 through row 2 as the title rows. *!*
*.printtitlerows = "$1:$2"
*!* Setting Title Columns would work in similar fashion to Setting Title *!*
*!* Rows. Here, however, the column letter would be used in syntax *!*
*!* similar to the above example. Here, however, a null string is *!*
*!* passed. This example simply shows that the option is available. *!*
*.printtitlecolumns = ""
*.printarea = &lctotalprintarea.
*.leftheader = lcexcelfile
*.CenterHeader = "&A"
*.centerheader = "Facturi Client"
*.rightheader = ""
*!* The below referenced "cStamp" is a procedure contained in this *!*
*!* program. It builds out a string which contains the computer system *!*
*!* date and time on which the resulting Excel file was created. *!*
*.leftfooter = cstamp()
.rightfooter = "Page &P of &N"
.centerhorizontally = .T.
.centervertically = .F.
.ORIENTATION = lnprintorientation
.PAPERSIZE = lnpapersize
.ZOOM = .F.
.fittopageswide = 1
*.fittopagestall = 99
ENDWITH
ENDWITH
ENDWITH
oexcel.cells(1,1).SELECT
oexcel.screenupdating = .T.
oexcel.VISIBLE = .T.
WAIT CLEAR
*!* iif(_soldinitial , m.tsid, m.trd)
*!* iif(_soldinitial , m.tsic, m.trc)
*!* m.tcd
*!* m.tcc
*!* m.ttd
*!* m.ttc
*!* m.tsd
*!* m.tsc
***EVERYTHING BELOW HERE IS MSDN SUPPLIED
*!****************************************************************************!*
*!* Beginning of PROCEDURE ColumnLetter *!*
*!* This procedure derives a letter reference based on a numeric value. It *!*
*!* uses the basis of the ASCII Value of the upper case letters A to Z (65 *!*
*!* through 90) to return the proper letter (or letter combination) for a *!*
*!* provided numeric value. *!*
*!****************************************************************************!*
PROCEDURE columnletter
PARAMETER lncolumnnumber
lnfirstvalue = INT(lncolumnnumber/27)
lcfirstletter = IIF(lnfirstvalue=0,"",CHR(64+lnfirstvalue))
lcsecondletter = CHR(64+MOD(lncolumnnumber,26))
RETURN lcfirstletter + lcsecondletter
*!****************************************************************************!*
*!* End of procedure ColumnLetter *!*
*!****************************************************************************!*
*!****************************************************************************!*
*!* Beginning of PROCEDURE cStamp *!*
*!* This procedure derives a text representation of the system date and time *!*
*!* in the form of: *!*
*!* 01/01/2000 11:59:00 would be rendered as: *!*
*!* Saturday, January 1, 2000 @ 11:59 am *!*
*!****************************************************************************!*
PROCEDURE cstamp
cdtstring1 = CDOW(DATE()) + ", "
cdtstring2 = CMONTH(DATE()) + " "
cdtstring3 = ALLTRIM(STR(DAY(DATE()))) + ", "
cdtstring4 = ALLTRIM(STR(YEAR(DATE()))) + " @ "
cdtstring5 = IIF(VAL(LEFT(TIME(), 2)) > 12, ;
ALLTRIM(STR(VAL(LEFT(TIME(), 2)) - 12)) +;
SUBSTR(TIME(), 3, 3), LEFT(TIME(), 5))
cdtstring6 = IIF(VAL(LEFT(TIME(),2))=>12,"pm","am")
cdtstring = "Created on " + cdtstring1 + ;
cdtstring2 + cdtstring3 + cdtstring4 + cdtstring5 + cdtstring6
RETURN cdtstring
*!****************************************************************************!*
*!* End of procedure cStamp *!*
*!****************************************************************************!*
SELECT cFacturiTotal
op = NEWOBJECT('Collection')
op.ADD(NEWOBJECT('Empty'),'headers') &&headers item, empty class
ADDPROPERTY(op.ITEM(1),'aHeaders[3,8]',.F.) &&aHeaders, array property, 8 columns
WITH op.ITEM(1)
* 1st header
.aheaders[1,1] = mHeader
.aheaders[1,2] = 1 &&row
.aheaders[1,3] = 2 &&column
.aheaders[1,4] = 'Arial' &&FontName
.aheaders[1,5] = 6 &&FontSize
.aheaders[1,6] = .T. &&FontBold
.aheaders[1,7] = .T. &&FontItalic
*2nd header
.aheaders[2,1] = mTitlu
.aheaders[2,2] = 2 &&row
.aheaders[2,3] = 2 &&column
.aheaders[2,4] = 'Arial' &&FontName
.aheaders[2,5] = 12 &&FontSize
.aheaders[2,6] = .T. &&FontBold
.aheaders[2,7] = .F. &&FontItalic
.aheaders[2,8] = -4108 &&Alignment ( xlCenter )
*3nd header
.aheaders[3,1] = mPerioada
.aheaders[3,2] = 3 &&row
.aheaders[3,3] = 2 &&column
.aheaders[3,4] = 'Arial' &&FontName
*.aheaders[3,5] = 16 &&FontSize
.aheaders[3,6] = .T. &&FontBold
.aheaders[3,7] = .F. &&FontItalic
.aheaders[3,8] = -4108 &&Alignment ( xlCenter )
ENDWITH
ADDPROPERTY(oP,'subtotals','11,3,4,5,6,7,8,9,10')
* first value ( 11 ) : group by column
* next values (3,4,5,6,7,8,9,10) : summed columns
Grid2Xls( THis.Parent.Grid1, op, 'cFacturiTotal', 2 )
Sursa PRG Gris2Xls:
PROCEDURE grid2xls
LPARAMETERS ogrid, oparameters , xrap, nHeaderObject
IF PCOUNT()< 4
nHeaderObject = 1
ENDI
*!* Program: grid2xls
*!* Author: Dorin Vasilescu
*!* Copyright: freeware
*!* Description: save table/cursor data to Excel using a grid as reference
* ( data ,columns, formatting, headers, DynamicBackColor)
*
* Parameters:
* oGrid: grid reference
* oParameters parameters objects, collection class, used to pass header rows, SaveAs file name, Subtotals
*
*Example:
* - headers:
* oP = NEWOBJECT('Collection')
* oP.Add(NEWOBJECT('Empty'),'headers') &&headers item, empty class
* AddProperty(oP.Item(1),'aHeaders[2,8]',.f.) &&aHeaders, array property, 8 columns
* WITH oP.Item(1)
* * 1st header
* .aHeaders[1,1] = 'Header 1 text:'
* .aHeaders[1,2] = 1 &&row
* .aHeaders[1,3] = 1 &&column
* .aHeaders[1,4] = 'Arial' &&FontName
* .aHeaders[1,5] = 16 &&FontSize
* .aHeaders[1,6] = .T. &&FontBold
* .aHeaders[1,7] = .T. &&FontItalic
* *2nd header
* .aHeaders[2,1] = 'Header 2 text'
* .aHeaders[2,2] = 4 &&row
* .aHeaders[2,3] = 4 &&column
* .aHeaders[2,8] = -4108 &&Alignment ( xlCenter )
* ENDWITH
*
* - SaveAs filename
*
* ADDPROPERTY(oP,'fileName','C:\Windows\Temp\test.xls')
*
*
* - subtotals (using comma delimited values)
*
* ADDPROPERTY(oP,'subtotals','1,3,4,5')
*
* first value ( 1 ) : group by column
* next values (3,4,5) : summed columns
*
*
* Call : grid2xls( oGrid, oP )
*
* OR : grid2xls( oGrid )
#DEFINE xlleft -4131
#DEFINE xlcenter -4108
#DEFINE xlright -4152
#DEFINE xlsum -4157
#DEFINE pixel_per_unit 7.5
#DEFINE msg_rows_processed "Inregistrari exportate: "
#IF .F.
LOCAL ogrid AS GRID
LOCAL oparameters AS COLLECTION
#ENDIF
LOCAL oexcel AS 'Excel.Application'
oexcel = .NULL.
TRY
oexcel = CREATEOBJECT('Excel.Application')
CATCH
MESSAGEBOX('Eroare initializare Excel.' + CHR(13) + 'Posibil neinstalat' , 0+16+4096 , 'Start Excel', 10000)
ENDTRY
*check if we continue or not
IF ISNULL(oexcel)
RETURN
ENDIF
IF NOT VARTYPE(ogrid) = 'O'
RETURN
ELSE
IF NOT ogrid.BASECLASS == 'Grid'
RETURN
ENDIF
ENDIF
LOCAL i, iitem, nfirstdatarow, nrowsprocessed, lhasparams, nheaderrow, oparmobj, ocolumn, lhasrap
LOCAL chditem, nrow, ncolumn, nrecno, crange, ndbcolor, ndfcolor, ocell
LOCAL ocols &&columns collection, needed to sort by ColumnOrder
nheaderrow = 1
nfirstdatarow = 2
nrowsprocessed = 0
lhasparams = (TYPE('oParameters') = 'O')
lhasrap = (TYPE('xrap') = 'C')
ocols = NEWOBJECT('Collection')
ocols.KEYSORT = 2
IF ogrid.RECORDSOURCETYPE = 1
SELECT (ogrid.RECORDSOURCE)
ELSE
*alias needed to be selected before calling
ENDIF
nrecno = RECNO()
*add columns ref to columns collection
FOR i = 1 TO ogrid.COLUMNCOUNT
*WAIT WINDOW ogrid.COLUMNS(i).controlsource
ocols.ADD(ogrid.COLUMNS(i), PADL(STR(i,3),3,'0'))
ENDFOR
*SUSPEND
oexcel.displayalerts = .F.
oexcel.screenupdating = .F.
*oexcel.workbooks.ADD
obook = oexcel.workbooks.ADD()
FOR i=2 TO oexcel.sheets.COUNT
oexcel.sheets(2).DELETE
ENDFOR
*set columns width/font
i = 0
FOR EACH ocolumn IN ocols
i = i + 1
WITH ocolumn
oexcel.COLUMNS(i).FONT.NAME = .FONTNAME
oexcel.COLUMNS(i).FONT.SIZE = .FONTSIZE
oexcel.COLUMNS(i).FONT.bold = .FONTBOLD
oexcel.COLUMNS(i).COLUMNWIDTH = (.WIDTH + 2*.PARENT.GRIDLINEWIDTH) / pixel_per_unit
ENDWITH
ENDFOR
IF lhasparams
IF PEMSTATUS(oparameters,'GetKey',5)
iitem = oparameters.GETKEY('headers')
ELSE
iitem = 0
ENDIF
IF iitem <> 0
oparamobj = oparameters.ITEM(iitem)
ENDIF
IF TYPE('oParamObj.aHeaders[1,1]') <> 'U'
WITH oparamobj
FOR i=1 TO ALEN(.aheaders,1)
*verify header item type
IF TYPE('.aHeaders[i,1]') = 'L'
chditem = ''
ELSE
chditem = .aheaders[i,1]
ENDIF
*verify header item row location type
IF TYPE('.aHeaders[i,2]') <> 'N'
nrow = i
ELSE
nrow = .aheaders[i,2]
ENDIF
*verify header item column location type
IF TYPE('.aHeaders[i,3]') <> 'N'
ncolumn = 1
ELSE
ncolumn = .aheaders[i,3]
ENDIF
*set header size, if necessary
IF nfirstdatarow < nrow + 2
nfirstdatarow = nrow + 2
ENDIF
oexcel.cells(nrow,ncolumn).SELECT
oexcel.SELECTION.VALUE = chditem
IF TYPE('.aHeaders[i,4]') = 'C'
oexcel.SELECTION.FONT.NAME = .aheaders[i,4]
ENDIF
IF TYPE('.aHeaders[i,5]') = 'N'
oexcel.SELECTION.FONT.SIZE = .aheaders[i,5]
ENDIF
oexcel.SELECTION.FONT.bold = .aheaders[i,6]
oexcel.SELECTION.FONT.italic = .aheaders[i,7]
IF TYPE('.aHeaders[i,8]') = 'N'
oexcel.SELECTION.horizontalalignment = .aheaders[i,8]
ENDIF
ENDFOR
ENDWITH
ENDIF
ENDIF
*Column Headers
nheaderrow = nfirstdatarow - 1
i = 0
FOR EACH ocolumn IN ocols
i = i + 1
oexcel.ROWS(nheaderrow).ROWHEIGHT = ogrid.HEADERHEIGHT
WITH ocolumn
oexcel.cells(nheaderrow,i).SELECT
oexcel.SELECTION.VALUE = .OBJECTS(nHeaderObject).CAPTION
oexcel.SELECTION.horizontalalignment = xlcenter
oexcel.SELECTION.verticalalignment = xlcenter
oexcel.SELECTION.wraptext = .T.
oexcel.COLUMNS(i).COLUMNWIDTH = .WIDTH / pixel_per_unit
ENDWITH
ENDFOR
WAIT WINDOW msg_rows_processed + STR( nrowsprocessed ) NOWAIT
SCAN
i = 0
FOR EACH ocolumn IN ocols
i = i + 1
WITH ocolumn
IF NOT EMPTY(.CONTROLSOURCE)
ocell = oexcel.cells(nfirstdatarow + nrowsprocessed, i)
IF NOT EMPTY(EVALUATE(.CONTROLSOURCE)) OR TYPE(.CONTROLSOURCE) = 'N'
ocell.VALUE = EVALUATE(.CONTROLSOURCE)
ENDIF
IF NOT EMPTY(.DYNAMICBACKCOLOR)
ndbcolor = EVALUATE(.DYNAMICBACKCOLOR)
IF ndbcolor <> ogrid.BACKCOLOR
ocell.interior.COLOR = ndbcolor
ENDIF
ENDIF
IF NOT EMPTY(.DYNAMICFORECOLOR)
ndfcolor = EVALUATE(.DYNAMICFORECOLOR)
IF ndfcolor <> ogrid.FORECOLOR
ocell.FONT.COLOR = ndfcolor
ENDIF
ENDIF
ctype = TYPE(.CONTROLSOURCE)
DO CASE
CASE ctype = 'C'
ocell.HorizontalAlignment = 2
OTHERWISE
ocell.HorizontalAlignment = 1
ENDC
ENDIF
ENDWITH
ENDFOR
nrowsprocessed = nrowsprocessed + 1
IF MOD(nrowsprocessed,SET("Odometer")) = 0
WAIT WINDOW msg_rows_processed + STR( nrowsprocessed ) NOWAIT
ENDIF
ENDSCAN
IF ogrid.COLUMNCOUNT <= 26
crange = 'A'+TRANSFORM(nheaderrow) + ':' + CHR(64+ogrid.COLUMNCOUNT) ;
+ TRANSFORM(nheaderrow + nrowsprocessed )
ELSE
crange = 'A'+TRANSFORM(nheaderrow ) + ':' ;
+ CHR(64+FLOOR(ogrid.COLUMNCOUNT/26)-1) ;
+ CHR(64+IIF(MOD(ogrid.COLUMNCOUNT,26)=0,26,MOD(ogrid.COLUMNCOUNT,26))) ;
+ TRANSFORM(nheaderrow + nrowsprocessed )
ENDIF
oexcel.RANGE(crange).SELECT
oexcel.SELECTION.BORDERS(1).linestyle = 1
oexcel.SELECTION.BORDERS(2).linestyle = 1
oexcel.SELECTION.BORDERS(3).linestyle = 1
oexcel.SELECTION.BORDERS(4).linestyle = 1
oexcel.activesheet.pagesetup.printtitlerows = "$1:$" + TRANSFORM(nheaderrow)
*subtotals, if needed, transmitted as comma delimited integers, first is group by column from 2nd, summed columns
IF lhasparams AND TYPE('oParameters.subTotals') = 'C'
LOCAL ARRAY atemp1[1], atemp2[1]
LOCAL igroupcount, igroupcolumn
igroupcount = ALINES(atemp,oparameters.subtotals,1,[,])
IF igroupcount > 1
FOR i = 1 TO igroupcount
atemp[i] = INT(VAL(atemp[i]))
ENDFOR
igroupcolumn = atemp[1]
ADEL(atemp,1)
DIMENSION atemp[iGroupCount - 1]
oexcel.SELECTION.subtotal(igroupcolumn, xlsum, @atemp, .T., .F., .T.)
ENDIF
ENDIF
IF lhasparams AND TYPE('oParameters.fileName') = 'C'
oexcel.activesheet.SAVEAS(oparameters.filename)
ENDIF
IF nrecno > 0 AND nrecno <= RECCOUNT()
GOTO nrecno
ENDIF
osheet = obook.activesheet
WITH oexcel
*WITH .worksheets(1)
* .COLUMNS.AUTOFIT
* .ROWS.AUTOFIT
*ENDWITH
WITH .activesheet
*OS=oexcel.activesheet && Daca faci asa va functiona IntelliSense in VFP ...
.pagesetup.ORIENTATION= 2 && xlLandscape
.pagesetup.topmargin=5
.pagesetup.bottommargin=5
.pagesetup.leftmargin=31
.pagesetup.rightmargin=2
lnpaperorientation = .pagesetup.ORIENTATION
DO CASE
CASE lnpaperorientation = 2
lnpapersize = 1
lnprintorientation = 2
CASE lnpaperorientation = 3
lnpapersize = 5
lnprintorientation = 1
CASE lnpaperorientation = 4
lnpapersize = 5
lnprintorientation = 2
OTHERWISE
lnpapersize = 1
lnprintorientation = 1
ENDCASE
lctotalrangeexpr = ["A1:] + columnletter(FCOUNT()) + ALLTRIM(STR(RECCOUNT() + 6)) + ["]
lctotalprintarea = ["$A$1:$] + columnletter(FCOUNT()) + [$]+ALLTRIM(STR(RECCOUNT() + 6)) + ["]
oexcelsheet = osheet
oexcelsheet.cells.SELECT
oexcelsheet.cells.entirecolumn.AUTOFIT
oexcelsheet.RANGE(&lctotalrangeexpr.).SELECT
WITH oexcelsheet.pagesetup
*!* This area sets to Title Rows of the spreadsheet that will be printed *!*
*!* on each page. Since this example contains the table field names on *!*
*!* the top row, and then an empty row of cells that was inserted by this *!*
*!* program, then we will set row 1 through row 2 as the title rows. *!*
*.printtitlerows = "$1:$2"
*!* Setting Title Columns would work in similar fashion to Setting Title *!*
*!* Rows. Here, however, the column letter would be used in syntax *!*
*!* similar to the above example. Here, however, a null string is *!*
*!* passed. This example simply shows that the option is available. *!*
*.printtitlecolumns = ""
*.printarea = &lctotalprintarea.
*.leftheader = lcexcelfile
*.CenterHeader = "&A"
*.centerheader = "Facturi Client"
*.rightheader = ""
*!* The below referenced "cStamp" is a procedure contained in this *!*
*!* program. It builds out a string which contains the computer system *!*
*!* date and time on which the resulting Excel file was created. *!*
*.leftfooter = cstamp()
.rightfooter = "Page &P of &N"
.centerhorizontally = .T.
.centervertically = .F.
.ORIENTATION = lnprintorientation
.PAPERSIZE = lnpapersize
.ZOOM = .F.
.fittopageswide = 1
*.fittopagestall = 99
ENDWITH
ENDWITH
ENDWITH
oexcel.cells(1,1).SELECT
oexcel.screenupdating = .T.
oexcel.VISIBLE = .T.
WAIT CLEAR
*!* iif(_soldinitial , m.tsid, m.trd)
*!* iif(_soldinitial , m.tsic, m.trc)
*!* m.tcd
*!* m.tcc
*!* m.ttd
*!* m.ttc
*!* m.tsd
*!* m.tsc
***EVERYTHING BELOW HERE IS MSDN SUPPLIED
*!****************************************************************************!*
*!* Beginning of PROCEDURE ColumnLetter *!*
*!* This procedure derives a letter reference based on a numeric value. It *!*
*!* uses the basis of the ASCII Value of the upper case letters A to Z (65 *!*
*!* through 90) to return the proper letter (or letter combination) for a *!*
*!* provided numeric value. *!*
*!****************************************************************************!*
PROCEDURE columnletter
PARAMETER lncolumnnumber
lnfirstvalue = INT(lncolumnnumber/27)
lcfirstletter = IIF(lnfirstvalue=0,"",CHR(64+lnfirstvalue))
lcsecondletter = CHR(64+MOD(lncolumnnumber,26))
RETURN lcfirstletter + lcsecondletter
*!****************************************************************************!*
*!* End of procedure ColumnLetter *!*
*!****************************************************************************!*
*!****************************************************************************!*
*!* Beginning of PROCEDURE cStamp *!*
*!* This procedure derives a text representation of the system date and time *!*
*!* in the form of: *!*
*!* 01/01/2000 11:59:00 would be rendered as: *!*
*!* Saturday, January 1, 2000 @ 11:59 am *!*
*!****************************************************************************!*
PROCEDURE cstamp
cdtstring1 = CDOW(DATE()) + ", "
cdtstring2 = CMONTH(DATE()) + " "
cdtstring3 = ALLTRIM(STR(DAY(DATE()))) + ", "
cdtstring4 = ALLTRIM(STR(YEAR(DATE()))) + " @ "
cdtstring5 = IIF(VAL(LEFT(TIME(), 2)) > 12, ;
ALLTRIM(STR(VAL(LEFT(TIME(), 2)) - 12)) +;
SUBSTR(TIME(), 3, 3), LEFT(TIME(), 5))
cdtstring6 = IIF(VAL(LEFT(TIME(),2))=>12,"pm","am")
cdtstring = "Created on " + cdtstring1 + ;
cdtstring2 + cdtstring3 + cdtstring4 + cdtstring5 + cdtstring6
RETURN cdtstring
*!****************************************************************************!*
*!* End of procedure cStamp *!*
*!****************************************************************************!*
Abonați-vă la:
Comentarii (Atom)