3 de junio de 2020

Exporta a Excel datos de un Cursor/Tabla mediante el llamado a una FUNCTION()

Se ha escrito mucho acerca de exportar datos a Excel. Pero esta funcion que modifique gracias a rutinas encontradas en este Blog, me ha sacado de apuros.

*-------------------------------------------------------------------------------------
*----------- FUNCTION EXPORTAR A MS EXCEL --------------------------------------------
*-------------------------------------------------------------------------------------
*-- MarcoMolina("27/07/2006")
*-- Genere una instruccion SQL READWRITE partiendo de una Tabla/Cursor
*-- con el formato que se desea.
*-- Limitacion exporta solo 26 campos a MS Excel
*-- USO:
*-- Exportar_Excel("CursorSQL","Encabezado del Reporte",Dsd,Hst,"Nombre de la Empresa",.f.)
* Dsd        : Fecha que inicia el rango del reporte, si no se requiere deje ""
* Dsd        : Fecha que final  del rango del reporte, si no se requiere deje ""
* CursorSQL  : Nombre de la Tabla/Cursor
* .t./.f.    : Indica que protege la hoja de excel con password

*--Forma de USO:
CLOSE DATABASES
SELECT 0
USE OrigenDatos

SELECT CAST(Camp0 AS N(1)) AS "I",;
  Camp1 AS Campo1,;
  Camp2 AS Campo2,;
  Camp3 AS Campo3;
  FROM OrigenDatos;
  WHERE BETWEEN(Fecha,Dsd,Hst);
  INTO CURSOR CursorSQL READWRITE

*--Instrucciones para dar formato al CursorSQL. Si se requiere.
IF RECCOUNT() > 0
  =Exportar_Excel("CursorSQL","Encabezado del Reporte",Dsd,Hst,"Nombre de Empresa",.F.)
ELSE
  WAIT WIND "No existen registros para procesar"
ENDIF

FUNCTION Exportar_Excel
  PARAMETERS cTabla,cTitulo,cDesde,cHasta,cEmpresa,cproteg
  IF VARTYPE(cProteg) = "U"
    cProteg = .F.      &&la hoja de excel estara protegida=.t. - modificable=.f.
  ENDIF
  IF TYPE("cDesde") = "L" OR TYPE("cHasta") = "L"
    Periodo = ""
  ELSE
    IF !EMPTY(cDesde) AND !EMPTY(cHasta)
      IF TYPE("cDesde") = "D" OR TYPE("cHasta") = "D"
        Periodo = "Desde: " + ALLTRIM(DTOC(cDesde)) +" Hasta: "+ ALLTRIM(DTOC(cHasta))
      ELSE
        Periodo = "Desde: " + ALLTRIM(cDesde) +" Hasta: "+ ALLTRIM(cHasta)
      ENDIF
    ELSE
      Periodo = ""
    ENDIF
  ENDIF
  *--Selecciona la tabla pasada por parametro - Resultado del SQL
  SELECT (cTabla)
  AreaTabla = SELECT()
  COUNT FOR !DELETED() TO Lineas

  *--Identificacion de la columna de la hoja Excel
  *--ID_Col   = Nombres de las columnas A1,B2,C3...
  *--AnchoCol = Ancho de la columna
  *--TipoCmp  = Formato del campo si es Caracter, Numerico, Fecha.
  CREATE CURSOR LargoCol (ID_Col C(10),AnchoCol N(8),TipoCmp C(1))

  *--Separa los campos de la tabla por comas
  *--Identifica la columna en la tabla ...A1,B2,C3,D4.....
  *--Solo 26 campos permite identificar de A-Z

  SELECT (AreaTabla)
  cString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  STORE "" TO cLago,cCh,nCampo
  FOR xCta = 1 TO FCOUNT()
    *--Lista de campos separados por comas.
    nCampo = nCampo + FIELD(xCta) + ","
    *--Largo de cada campo
    cLago=FSIZE(FIELD(xCta))
    *--Tipo de campo
    cTipo=TYPE(FIELD(xCta))
    *--Establece el ancho de la columna como minimo 13 espacios
    IF cLago <= 10
      cLago = 13
    ENDIF
    *--Identifica las columnas A1 B2 C3..
    cCh = SUBSTR(cString,xCta,1)
    gCh = cCh+ALLTRIM(STR(xCta))
    *--Guarda la configuracion del tamñano de los campos y nombre etc.
    INSERT INTO LargoCol (AnchoCol,ID_Col,TipoCmp) VALUES (cLago,gCh,cTipo)
    *--Reestablece la tabla
    SELECT (AreaTabla)
  NEXT
  SELECT (AreaTabla)

  *--Quita la ultima "," de la concatenacion de los nombres de campos del cursor
  nCampo = SUBSTR(nCampo,1,LEN(nCampo)-1)

  *--Determinar la ultima columna del reporte
  SELECT LargoCol
  xEnca = LEFT(ALLTRIM(Id_Col),1) + "5"
  xHay = LEFT(ALLTRIM(Id_Col),1) + ALLTRIM(STR(Lineas+7))

  *--Solo 26 campos son exportables
  IF xCta > 26
    =MESSAGEBOX("La tabla... &cTabla tiene...(" + ALLTRIM(STR(xCta)) + ") " + ;
      "campos, de los cuales solo... (26) pueden ser " + CHR(13)+;
      "exportados a MS Excel.",48,Titulo)
    CLOSE DATABASES
    RETURN
  ENDIF
  *---------------------------------------------------------
  *-- EXPORTA LA TABLA
  *---------------------------------------------------------
  WAIT WINDOW "Abriendo MS Excel..." NOWAIT

  SELECT (AreaTabla)
  *-- Nombre y path de la hoja
  TxtFilename = FULLPATH("Temps\Exprt_Excel"+Usuario)

  EXPORT FIELDS &nCampo TO ALLTRIM((TxtFileName)) TYPE XL5
  oExcel = CREATEOBJECT("Excel.Application")
  WITH oExcel
    .DisplayAlerts = .F.
    .Workbooks.OPEN(TxtFilename)
    .ActiveWindow.DisplayZeros = "FALSE"
    *- Renombra la hoja de calculo
    cHoja=RIGHT(TxtFileName,13) &&"Exprt_Excel"+Usuario
    .Sheets("&cHoja").SELECT
    .Sheets("&cHoja").NAME = "MM-Empresarial"
    *--Inserta lineas en blanco para titulos del reporte
    .RANGE("A1:A4").SELECT
    .SELECTION.EntireRow.INSERT
    *--Formatea el ancho de las columnas en la hoja
    SELECT LargoCol
    SCAN ALL
      _Col = ALLTRIM(ID_Col)
      _Cls = LEFT(_Col,1)
      _Ach = AnchoCol
      .COLUMNS("&_Cls:&_Cls").COLUMNWIDTH = _Ach
      *--Si la columna es numerica le da el formato
      IF ALLTRIM(TipoCmp) = "D"
        .RANGE("&_Cls:&_Cls").HorizontalAlignment = -4152
      ENDIF
      IF ALLTRIM(TipoCmp) = "N"
        *--Alinemiento del encabezado de la columna
        .RANGE("&_Cls:&_Cls").HorizontalAlignment = -4152
        _Fin = "&_Cls"+ALLTRIM(STR(Lineas+50))
        .RANGE("A1:&_Fin").SELECT
        .SELECTION.NumberFormat = "#,##0.00"
      ENDIF
      *--Coloca las mayusculas a los encabezados de columna
      _Clu = LEFT(ALLTRIM(ID_Col),1)
      _DsdA5 = "&_Clu"+"5"
      .RANGE("&_DsdA5:&_DsdA5").SELECT
      .RANGE("&_DsdA5:&_DsdA5").VALUE = UPPER(.RANGE("&_DsdA5:&_DsdA5").VALUE)
    ENDSCAN
    *--Inserta nombre de la empresa y titulo del reporte
    .RANGE("A1:A1").SELECT
    .RANGE("A1:A1").VALUE = UPPER(ALLTRIM(lpEmpresa))
    .RANGE("A2:A2").SELECT
    .RANGE("A2:A2").VALUE = cTitulo
    .RANGE("A3:A3").SELECT
    .RANGE("A3:A3").VALUE = Periodo
    *--Formato/Presentacion de hoja
    .RANGE("A1:&xHay").SELECT
    .SELECTION.AutoFormat(1,.T.,.T.,.T.,.T.,.T.,.T.)
    *--Color del fondo de encabezado de columnas
    .RANGE("A5:&xEnca").SELECT
    WITH .SELECTION.Interior
      .ColorIndex = 36
      .PATTERN = 1
    ENDWITH
    *--Fuente para la hoja
    .RANGE("A6:&xHay").SELECT
    WITH .SELECTION.FONT
      .NAME = "Arial"
      .SIZE = 9
    ENDWITH
    *--Fuente para el titulo del reporte
    .RANGE("A1:A1").SELECT
    WITH .SELECTION.FONT
      .NAME = "Arial"
      .SIZE = 12
    ENDWITH
    *--Inserta una columna en blanco
    .SELECTION.EntireColumn.INSERT
    IF xCta > 3
      .COLUMNS("A:A").COLUMNWIDTH = 8
    ELSE
      .COLUMNS("A:A").COLUMNWIDTH = 3
    ENDIF
    *---Protege la hoja con password
    IF cProteg
      *--Proteje la hoja
      .ActiveSheet.PROTECT("MaMh,.t.,.t.")
    ENDIF
    .VISIBLE = .T.
  ENDWITH
  WAIT CLEAR
  RETURN
ENDPROC

Gracias Comunidad de VFP en Español y adelante.

Tonny Molina

15 de mayo de 2020

MESSAGEBOX() ejecuta un TRANSFORM() implícito del texto

El primer parámetro aceptado por MESSAGEBOX() es automáticamente transformado (TRANSFORM()) por VFP 7 y superior.

Así que usted puede hacer lo siguiente sin tener que usar TRANSFORM() con el texto del mensaje ni preocuparse de del tipo de datos:

messagebox(datetime()) 
messagebox(123.45) 
messagebox(date()-date(1999,10,01)) 
messagebox(.f.) 
messagebox(.NULL.)

VFP Tips & Tricks - Drew Speedie

1 de mayo de 2020

Añadiendo funcionalidad al Dataexplorer.App

Script que inserta en un formulario en tiempo de diseño un control label y textbox mediante técnica de arrastrar y soltar desde una columna de una base de datos remota usando la aplicación Dataexplorer.app

Hace poco me puse a investigar el Dataexplorer.App y descubrí que se puede configurar algunas características a fin de hacer mas rápido el desarrollo de aplicaciones, en mi caso particular, cuando trabajo con base de datos remota como SQL Server.

Por defecto el Dataexplorer.app al arrastrar desde una columna de la base de datos remota hacia un Form te inserta un control grid junto con el cursoradapter respectivo. En mi caso particular no me sirve ya que en mis desarrollos tengo clases que me crean el entorno de datos para mis formularios. Me sería mas útil que inserte la columna como un control Textbox y su control Label respectivo. Así es que revisando el código fuente del Script que realiza esa funcionalidad, descubrí que se podía modificar, así es que he creado un script que hace lo que necesito.

Aquí les presento el código:

*  <oParameter> = parameter object
*  oParameter members:
*   DropText - populate this with the text to drop
*   Cancel - set to .T. to cancel the drag/drop operation
*   Continue - set to .F. to stop processing additional add-ins
*   oDataExplorerEngine
*   TreeNode
*   RootNode
*   MouseXPos
*   MouseYPos
*   NodeData
*   CurrentNode
*   ParentNode
*   ControlName
*   ClassName
*   ClassLocation
*   PropertyList
*   Caption
*
LPARAMETERS oParameter

LOCAL lcInc, lcName, loSource, laObjs, lcInitCode, lcAutoOpenCode
LOCAL cConnString, oConn, lcTable, lcAlias, lcSelectStr, lcName2,loForm

DIMENSION laObjs[1]
loForm=SYS(1270)

* Check for DE. Only support for forms
lnCount=ASELOBJ(laObjs,2)  && check for DE
IF lnCount = 0 OR TYPE("loForm") <> 'O'
  oParameter.Continue = .T.
  RETURN
ENDIF

* Get Column Name
DO CASE
  
CASE oParameter.CurrentNode.NodeData.Type == "Column"
  * Handle dragdrop from field node in table/view
  lcTable = oParameter.ParentNode.NodeData.Name
  lcTable = IIF(ATC(" ",lcTable)>0,"["+lcTable+"]", lcTable)
  lcAlias = oParameter.ParentNode.NodeData.Name

ENDCASE


IF UPPER(loForm.Baseclass)=="FORM"
  LOCAL iTop as Integer, iLeft as Integer
  iTop  = MROW(0,3)
  iLeft = MCOL(0,3)

  * Control TextBox
  lcInc = ""
             lcName2 = oParameter.ControlName
  lcName2 = CHRTRAN(lcName2," ","_")
  DO WHILE TYPE("loForm." + m.lcName2 + m.lcInc)#"U"
    m.lcInc = ALLTRIM(STR(VAL(m.lcInc)+1))
  ENDDO
  lcName2 = m.lcName2 + m.lcInc
      loForm.NewObject(lcName2, oParameter.ClassName, oParameter.ClassLocation)
      IF PEMSTATUS(loForm.&lcName2, "ControlSource", 5)
      WITH loForm.&lcName2
         .ControlSource = ALLTRIM(lcTable)+"."+ALLTRIM(oParameter.CurrentNode.NodeData.Name)  
         .Top = iTop
         .Left = iLeft + 100
         .Name = left(LOWER(.Name),3)+PROPER(SUBSTR(.Name,4,50))
      ENDWITH
   ENDIF

  * Control Label
  lcIncLbl=""
  lcNameLabel="lbl"+ALLTRIM(oParameter.CurrentNode.NodeData.Name)
  DO WHILE TYPE("loForm." + m.lcNameLabel + m.lcIncLbl)#"U"
    m.lcIncLbl = ALLTRIM(STR(VAL(m.lcIncLbl)+1))
  ENDDO
  lcNameLabel = m.lcNameLabel + m.lcIncLbl
   loForm.addObject(lcNameLabel, "Label")
   IF PEMSTATUS(loForm.&lcNameLabel, "Caption", 5)
      WITH loForm.&lcNameLabel
         .Name = left(LOWER(.Name),3)+PROPER(SUBSTR(.Name,4,50))
         .Top = iTop
         .Left = iLeft
         .Caption = ALLTRIM(oParameter.CurrentNode.NodeData.Name)
         .Autosize = .t.
      ENDWITH
   ENDIF

ENDIF
oParameter.ClassName = ""  
oParameter.Continue = .F.

Con este Script logro insertar en mi formulario en tiempo de diseño un control Textbox junto con su respectivo control label. En el control textbox se configuran la propiedad ControlSource con el nombre de la Tabla y el nombre de la columna (TableName.ColumnName). La propiedad Name se define anteponiendo la palabra "txt" seguido del nombre de la columna de la tabla (txtColumnName). En el caso del control Label la propiedad Caption se define con el nombre de la columna y su propiedad Name se define anteponiendo la palabra "lbl" mas el nombre de la columna de la tabla.

CONFIGURACION

Llamar al Dataexplorer.App desde la ventana de comandos con DO HOME() + "dataexplorer.app"

Hacer Click en el Boton Options y entrar a Manage Drag/Drop. Seleccionar la opción Drag/Drop to Designe Surface e Insertar un nuevo registro haciendo Click en el Boton New.

En la pestaña General poner en el campo Caption una descripción o etiqueta para el script, por ejemplo "SQL/ADO Fields" sin las comillas. Ir a la pestaña Script to Run y poner en el campo Execute Only for the following Nodes (comma - separated) lo siguiente: "ADOColumnNode,SQLColumnNode" sin las comillas y en el campo Code to Execute upon Drop copiar el script mostrado arriba. Grabar haciendo click en el botón Save o Apply.

Ahora lo único que falta es desactivar la funcionalidad que viene por defecto a fin de que se ejecute nuestro nuevo script. Para hacer esto seleccionar de la lista el registro SQL/ADO Tables, Views and Fields. Ir a la pestaña Script to Run y eliminar del campo Execute Only for the following Nodes (comma - separated) las siguientes etiquetas: ADOColumnNode y SQLColumnNode y grabar con Save o Apply.

Espero este Scrip pueda serle útil a la gran comunidad fox.

Saludos.

Miguel Herbias
Lima - Peru