Use Home(2)+ "dataemployee" Alias Emp
Shared
cCrLf = Chr(13) + Chr(10)&& Salto de línea

oPPT = CreateObject("PowerPoint.Application")
oPPT.Visible
= .T.

cTmpl="c:Archivos de programaMicrosoft Office"+;
     "TemplatesPresentation DesignsGlobe.pot"

oPres = oPPT.Presentations.Add
oPres.ApplyTemplate(cTmpl)

Select Emp
Scan
   oSlide = oPres.Slides.Add(1,2)

   oShapes = oSlide.Shapes

   oTitulo = oShapes.Item("Rectangle 2")
   oTitulo.TextFrame.TextRange.Text= Trim(Last_Name) + " " + Trim(First_Name)

   cStr = "Cargo: "+
Trim(Title) + cCrLf
   cStr = cStr + "País: " + Trim(Country) + cCrLf
   cStr = cStr + "Ciudad: " + Trim(City) + cCrLf

   oTitulo = oShapes.Item("Rectangle
3")
   oTitulo.TextFrame.TextRange.Text= cStr
EndScan

Use in Emp

oPres.SaveAs("C:MiPresentacion.ppt")
oPres.Close
oPPT.Quit

oPPT =CreateObject("PowerPoint.Application")
oPPT.Visible = .T.
oPres = oPPT.Presentations.Open("C:Prueba.PPT")

* Inicia la presentación

oSlideShow = oPres.SlideShowSettings.Run.View

With oPres.Slides.Range
   * Segundos que se muestra cada diapositiva
   .SlideShowTransition.AdvanceTime = 2

   * Las diapositivas serán controladas por los
      segundos establecidos anteriormente.
    .SlideShowTransition.AdvanceOnTime = .T.

EndWith
 

oPPT = CreateObject("PowerPoint.Application")
oPPT.Visible = .T.


cRutaTmpl="c:Archivos de programaMicrosoft Office"+;
           "TemplatesPresentation DesignsGlobe.pot"

oPres = oPPT.Presentations.Add
oPres.ApplyTemplate(cRutaTmpl)
oSlide = oPres.Slides.Add(1,
2)

oShapes = oSlide.Shapes
oTitulo = oShapes.Item("Rectangle 2")
oTitulo.TextFrame.TextRange.Text= "Prueba de Titulo"
 

Por ejemplo: Cuando estamos en el Init de un formulario y digito:

With Thisform

   .

En ese momento deben salirme la lista de objetos y propiedades presentes en el formulario pero no funciona.

Para que funcione debemos reemplaza a Thisform por This.... ejemplo

With This
   .

En este caso si de muestran los objetos y propiedades del Formulario.

Espero que para futuras versiones o para el service pack 1 de VFP 9 se corrija el "pequeño detalle".

Lo que debes hacer es crear un método llamado Recorrer y colocar el siguiente código:

Lparameters oObj

Local oControl
For Each oControl In oObj.Objects
   Wait window oControl.Name

   If Pemstatus(oControl, 'Objects', 5)
       This.Recorrer(oControl)
   EndIf
EndFor

Cuando quieras conocer los objetos de un contenedor solo le debes pasar el contenedor al método. Por ejemplo: Los objetos
de un formulario:

Thisform.Recorrer(Thisform)

En caso que quieras conocer los objetos de un pageframe entonces le pasas como parámetro el Pageframe

Thisform.Recorrer(Thisform.PageFrameMio)

 

oConn = NewObject("ADODB.Connection")
oRst = NewObject("ADODB.Recordset")

stroConn = "Provider=sqloledb;"

           "Data Source=SERVIDOR;"+ ;
           "Initial Catalog=BASEDATOS;"
           "User Id=USUARIO;"+ ;
           "Password=CLAVE; "
oConn.Open(stroConn)

cSQL = "SELECT * FROM Tabla"
oRst.Open(cSQL, oConn, 3, 1, 1)

oRst.Find("Campo = '0001'")

?oRst.Fields("Campo").Value

* Restar 2 meses
? Gomonth(Date(), -2)


* Sumar 7 días
? Date() + 7

* Sumar 7 meses
? Gomonth(Date(), 7)


* Restar 100 días
? Date() - 100

* Sumar 1 año
? Gomonth(Date(), 12)
 

En la variable cComando puedes colocar cualquier instrucción válida de MS-DOS que luego será ejecutada; Si deseas que la ventana sea visible solo cambia el último parámetro de a función ShellExecute y colócalo en 1

Declare Integer ShellExecute In shell32.Dll;

    Integer hndWin, String cAction, String cFile,;
   String cParams, String cDir, Integer nShow

cComando = "Dir
c:*.*"
cArchivo = GetEnv("TEMP") + "" + Sys(2015) + ".bat"

=StrToFile(cComando, cArchivo)
=ShellExecute(0,"Open",cArchivo,"","",0)

 

oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add()

oSheet = oExcel.ActiveSheet

oSheet.Range("A1").Formula="Oscar"
oSheet.Range("A2").Formula="Maria"
oSheet.Range("A3").Formula="Juan"

oSheet.Range("A4").Formula="Pedro"
oSheet.Range("A5").Formula="Ana"
oSheet.Range("B1").Formula="435"

oSheet.Range("B2").Formula="213"
oSheet.Range("B3").Formula="592"
oSheet.Range("B4").Formula="150"

oSheet.Range("B5").Formula="97"

oChart = oSheet.ChartObjects.Add(150, 10, 200, 200)
oSheet.ChartObjects(1).Chart.ChartWizard(;
oSheet.range(oSheet.cells(1,1),oSheet.cells(5,2)),;
-4100,4,1,0,1,1,"","","","")


oExcel.Visible= .T.

With This.Grid1
   nCeldas = Int(.Height
- .HeaderHeight)/.RowHeight
   Wait Windows Transform(nCeldas)
EndWith
 

oRst = CreateObject("ADODB.Recordset")
oConn = CreateObject("ADODB.Connection")


cStrConn = "PROVIDER=Microsoft.Jet.OLEDB.4.0;"+ ;
           "DATA SOURCE=C:NWIND.MDB;"

With oConn
   .ConnectionString = cStrConn
   .CursorLocation = 3 && adUseClient
   .Mode = 3 && adModeReadWrite

   .Open(cStrConn)
EndWith

cSQL = "Select * from Clientes"

With oRst
   .ActiveConnection = oConn
   .CursorType = 3 && adOpenStatic
   .CursorLocation = 3
&& adUseClient
   .LockType = 3 && adLockOptimistic
   .Open(cSQL)
EndWith

Do While !oRst.Eof
    ? oRst.Fields("IdCliente").Value

   oRst.MoveNext
EndDo

 

oDlg = CreateObject("safrcFileDlg.fileSave")
oDlg.fileName =
"C:*.*"
oDlg.fileType = "Cualquier archivo"
oDlg.OpenFileSaveDlg()
? oDlg.fileName
 

Localo
o = Createobject("myform")
o.Show(1)

Define Class myform
As Form
   DoCreate = .T.
   DataSession = 2
   AutoCenter = .T.
   Caption = "Trabajando con DyamicBackGround"
   Width = 600

   Height = 400
   MinHeight = 300
   MinWidth = 300
   Add Object grid1 As Grid With ;
       HEIGHT =
This.Height, ;
       WIDTH = This.Width, ;
       DELETEMARK = .F.

   Procedure Load

        Select * From (_samples+"datacustomer") ;
           Order By MaxOrdAmt Desc;
                     Into Cursor TmpCust
      Use In
"customer"
   EndProc

   Procedure Init
        This.grid1.SetAll("dynamicbackcolor",;
                            "Thisform.GetBackColor(allt(country))")
    EndProc


   Procedure Resize
        This.grid1.Width= This.Width
      This.grid1.Height= This.Height
   EndProc

   Function GetBackColor(cCountry)

        Local nColor
       Do Case
           Case cCountry == "Germany"
               nColor = Rgb(255,255,255)
           Case cCountry ==
"UK"
               nColor = Rgb(224,224,0)
           Case cCountry == "Sweden"
               nColor = Rgb(224,224,160)
           Case
cCountry == "France"
               nColor = Rgb(100,224,160)
           Case cCountry == "Spain"
               nColor = Rgb(100,224,160)
           Otherwise
               nColor = Rgb(224,100,224)
       EndCase
       Return nColor
   EndFunc
EndDefine
 

El asterisco ( * ) permite inhabilitar algunas cositas de VFP.... en este caso, no funcionaran las combinaciones de teclas para copiar (CTRL+C), Pegar (CTRL+V).

ON KEY LABEL CTRL+V *

ON KEY LABEL CTRL+C *

Cuando el usuario presione dichas combinaciones de teclas no harán nada. y de igual forma puedes hacer con todas las teclas.

Quieres que tu programa nunca mande un error... mejor dicho ¿quieres esconder tus errores? ... Interesante no?

On Error *

Y si deseas evitar que el usuario salga del programa ..

On Shutdown *

Prueba con otras opciones y comprobaras lo útil que es el asterisco ( * )

Set Library To Sys(2004)+"fpsql.fll"

Public errval, errmsg, handle
errval=0

errmsg=" "
SourceName= "test"
User=
"sa"
passwd=""

* Conexión
handle=DBConnect(SourceName,User,passwd)

If handle > 0
   Wait Window
"Conectado" Nowait
Else
   Err=DBError(0,@errmsg,@errval)
   Wait Window Str(errval)+" "+errmsg
Endif

=DBSetOpt(handle,"Asynchronous",0)

=DBSetOpt(handle,"BatchMode",1)
=DBSetOpt(handle,"ConnTimeout",0)
=DBSetOpt(handle,"Transact",1)
=DBSetOpt(handle,"UseTable",0)

err=DBExec(handle,"use pubs")


If Err < 0
   =MessageBox("Error")
   Return .F.
EndIf


SqlCmd= "Execute ConsultarOrden '25'"
err=DBExec(handle,SqlCmd)

If err > 0
   Browse
Else
   =MessageBox("Error")

   Return .F.
Endif

*Desconexión
err=DBDisconn(handle)