Mostrando las entradas con la etiqueta Automation. Mostrar todas las entradas
Mostrando las entradas con la etiqueta Automation. Mostrar todas las entradas

19 de enero de 2021

Aplicaciones de terceros desde nuestros formularios

Artículo original: 3rd party apps from within our forms
https://sandstorm36.blogspot.com/2014/05/3rd-party-apps-from-within-our-forms.html
Autor: Jun Tangunan
Traducido por: Luis María Guayán


Ahora es la 1:30 AM y todavía no puedo volver a dormir, así que hagamos que mi tiempo sea un poco útil. Inspirado por lo que Bernard Bout ha mostrado AQUI, hoy decidí ver de que forma se puede haceruna instancia de Excel. Por favor, lea en enlace anterior antes de proceder a continuar como voy a tratar de separar las cosas para nuestra mejor comprensión.

Las herramientas más básicas del oficio

  • un Shape en nuestro formulario
  • SetParent
  • WinExec
  • FindWindow
  • SetWindowPos

Bernard nos dió un gran punto de partida porque los ingredientes básicos ya están ahí. Y estoy de acuerdo y aprecio que Bernard no haya mostrado todos los trucos porque si los ha hecho, no trataré de entender algunos de ellos y simplemente usaré el truco a ciegas; y no los comprenderé mejor.

Comencemos la deconstrucción y reconstrucción:

¿WinExec es la única forma?

No. Está ya que es uno de los comandos más simples para abrir una aplicación de terceros. Pero hay alternativas como RUN, ShellExecute(), Scripting y algunas más.

Me he dado cuenta de que el objetivo principal y el primer paso es abrir el archivo o la aplicación de cualquiera de las formas posibles y, dado que mi objetivo aquí es Excel, me gusta la automatización cuando se trata de Excel, entonces es la automatización.

¿Donde está la ventana?

El segundo paso después de abrir la aplicación de terceros es controlar la ventana de esa aplicación tratando de encontrarla. Y eso se puede hacer a través de Winapi con FindWindow() de esta manera:

nHwnd = FindWindow(NULL, "Untitled - Notepad")

Donde nHwnd es el identificador de ventana de la aplicación de terceros que queremos. Lo anterior dice, en términos sencillos, busque una instancia de Bloc de Notas recién abierta y sin guardar entre las ventanas abiertas y obtenga el identificador de su ventana para que podamos trabajar más en ella. Ese título es lo que verá como título cuando abra un Bloc de Notas solo.

Si VFP no puede encontrar el identificador de la ventana, nHwnd devolverá 0.

Intente con un formato de archivo xlsx

Como estaba haciendo la automatización, el primer intento se realiza en un archivo xlsx:

Local loExcel As excel.Application, lcFile
loExcel = Createobject('excel.application')
lcFile = Getfile('xls,xlsx')
If !Empty(m.lcFile)
      loExcel.Workbooks.Open(m.lcFile)
      * Get a handle on its Window
      nHwnd = FindWindow('XLMain',Alltrim(Justfname(m.lcFile))+' - Microsoft Excel')
Endif

¡Y falla, no pasó nada! Tarde me doy cuenta de que a pesar de lo que se muestra en la pantalla en la barra de título de Excel 2007, internamente todavía lo está haciendo de la manera anterior como esta:

nHwnd = FindWindow('XLMain','Microsoft Excel - '+Alltrim(Justfname(m.lcFile)))

No hace falta decir que lo anterior funciona. ¡Hasta aquí todo bien!

Intente con un formato de archivo xls

Luego intenté abrir un formato de archivo xls y ¡vuelve a fallar! ¡¡¡Maldito!!! Recordé que cuando abres un archivo xls en Excel 2007, se agregará un título adicional de [Modo de compatibilidad]. Esa es una forma de recordarnos visualmente que actualmente estamos trabajando en un formato de archivo antiguo. Hmmm ... pedazo de alcornoque, lo haré así entonces:

* Attempt to open without that compatibility mode caption
nHwnd = FindWindow(Null, "Microsoft Excel - "+Alltrim(Justfname(m.lcFile)))
If m.nHwnd = 0
      * Failed, so attempt to open with that added compatibility mode caption
      nHwnd = FindWindow('XLMain', 'Microsoft Excel - +Alltrim(Justfname(m.lcFile))+' [Compatibility Mode]')
Endif

Y no se abre correctamente. Quiero decir, se abre pero se abre fuera de mi aplicación por sí solo. ¡¡¡Maldito sea !!!

Perdí mi tiempo tratando de encontrar la combinación correcta en el título interno de la barra de título de Excel aplicando los casos reales de nombre de archivo usando FSO ... todavía no tuve suerte (me di cuenta al final a través de repetidas pruebas, aunque ese caso de caracteres como adecuado, superior e inferior no lo afecte), mezclando y reubicando las palabras en el pie de foto ... de nuevo no tuve suerte ... y estaba a punto de rendirme porque ya he perdido casi 2 horas solo para ese estúpido título interno (hey yo estaba frustrado, ¡LOL!) y estba a punto de archivar todo el proyecto cuando se me ocurrió una idea. ¡¡¡¡Diablos!!!! Estoy haciendo automatización, entonces, ¿qué me impide hacer esto?

nHwnd = FindWindow('XLMain', loExcel.Caption)

Y listo !!!! ¡Una forma muy flexible de asegurarse de encontrar el título correcto de un archivo de Excel abierto sin importar si está en modo de compatibilidad o no, o en cualquier versión de Excel que esté usando! ¡Excelente! Por supuesto, dicho enfoque no se limita a Excel.

Shape de mi corazón

Ahora vamos a la otra parte. Lo que también he notado es que el truco usa un Shape. Y cuando leí y vi el truco por primera vez, mi presunción es que Excel o cualquier aplicación de terceros aparece mágicamente en dicho Shape transformando dicho Shape en esa aplicación de terceros. Pero como ahora estoy tratando de separar las cosas, me doy cuenta de que con o sin ese Shape, podemos abrir esas aplicaciones de terceros dentro de nuestra aplicación.

Entonces, ¿para qué es ese Shape? Dicho Shape invisible/visible (su elección) en el formulario existe solo por una razón. Eso no es para mostrar la aplicación de terceros, sino para servir como una manera fácil de establecer las coordenadas de esas aplicaciones de terceros desde nuestro formulario, ya que es más fácil cambiar el tamaño de un Shape e indicar a dicha aplicación de terceros que "siga" las coordenadas de ese Shape, que hacerlo por código, de forma repetida y a prueba y error.

Cree un Shape, dimensione y colóquelo en el formulario a su gusto, escóndelo si lo desea e indique a la aplicación de terceros que siga sus coordenadas. Muy ingenioso por aquellos que originalmente pensaron en la idea.

¡Excel no se puede hacer clic, no se puede editar y está muy loco!

Para simplificar las cosas, me doy cuenta de que con VFP, aunque "nosotros" podemos ver los objetos, internamente no puede ser visto por VFP. Al igual que cuando agregamos mediante códigos algunos objetos en un Grid, tenemos que hacerlo Visible, de lo contrario, puede verlos pero no puede funcionar correctamente en él. Entonces:

loExcel.Visible = .T.

Entonces, si desea que esto se destaque dentro de nuestro formulario solo con fines de visualización pura, establezca la propiedad Visible en .F.

loExcel.Visible = .F.

Y eso es todo. Todo lo que el usuario puede hacer es desplazarse hacia abajo y hacia arriba para ver su contenido. :)

¿Que hay en el menu?

Pero una vez que haya hecho visible Excel, entonces todo el archivo de Excel estará dentro de nuestro formulario con todo su esplendor como cinta, barra de fórmulas, pestañas de la hoja de trabajo, etc. Bueno, algunos de ustedes pueden quererlo de esa manera, pero yo no. Así que tengo que esconderlos. Simplemente verifique los códigos más adelante para saber cómo hacerlo.

¡Dimensióname!

No es sorprendente que el cambio de tamaño del formulario deje la aplicación de terceros en sus coordenadas originales. Pero esto es fácil, revisa los códigos.

Hacer zoom, guardar, detectar y algo más

Solo revisa los códigos ... Estoy empezando a tener sueño, finalmente...

Resumen:

Hay dos o más cosas que estoy buscando pero que todavía no he podido encontrar una solución y que tampoco me siento cómodo dejando esos asuntos sin resolver. Y lo básico de esos deseos son:

  • Ocultar la barra de título de Excel
  • No permitir arrastrar y soltar

Incluso jugar con uFlags de SetWindowPos no me dio los resultados esperados. Sin embargo, pude utilizar una buen Flag cuando intentamos abrir un nuevo archivo de Excel para que Excel no destruya lentamente sus objetos frente a nuestros ojos cuando lo cerramos.

Seguiré jugando con esto y si encuentro formas, actualizaré esto. O dado que el plan, como de costumbre, es publicar este foro interno de Foxite, que se encuentra entre los foros de desarrolladores más amigables que he visto, con suerte alguien que haya jugado con esto antes que yo (lo siento, siempre llego tarde) pueda compartir con nosotros cómo solucionar esos problemas; luego editaré esta publicación para incluir sus códigos y al colaborador.

El día siguiente:

¡Encontré el eslabón perdido, LOL! El truco para ocultar la barra de título de Excel es, en lugar de buscar propiedades ocultas de Excel para ocultarlas, manipularlo directamente usando estas dos WinAPI, es decir, GetWindowLong y SetWindowLong. Esos son posibles porque ya tenemos el Handle de la ventana. ¡Compruebe en los códigos a continuación cómo se hace!

Códigos:

loTest = Createobject("Form1")
loTest.Show(1)

Define Class Form1 As Form
      AutoCenter= .T.
      Height = 493
      Width = 955
      Caption = 'Excel within our Form'
      _nHwnd = .F.
      _oExcel = .F.

      Add Object Shape1 As Shape With ;
            Top = 36, Left = 6, Height= 445, Width = 936,;
            BackColor = Rgb(255,255,255), BorderColor = Rgb(0,128,192)

      Add Object label1 As Label With ;
            Top = 15, Left = 6, Caption = 'Preview', FontBold = .T.,;
            FontName = 'Calibri', FontSize = 12, AutoSize = .T.

      Add Object label2 As Label With ;
            Top = 12, Left = 836, Caption = 'Zoom', FontBold = .T.,;
            FontName = 'Calibri', FontSize = 12, AutoSize = .T.,;
            Anchor = 9

      Add Object cmdOpen As CommandButton With ;
            Top = 8, Left = 312, Caption = '\<Open', Width = 84, Height = 24

      Add Object cmdSave As CommandButton With ;
            Top = 8, Left = 399, Caption = '\<Save', Width = 84, Height = 24

      Add Object cmdClose As CommandButton With ;
            Top = 8, Left = 486, Caption = '\<Close', Width = 84, Height = 24

      Add Object chkShowTabs As Checkbox With ;
            Top = 12, Left = 732, Caption = 'Show \<Tabs', AutoSize = .T.,;
            Anchor = 9

      Add Object SpinZoom As Spinner With ;
            Top = 10, Left = 882, KeyboardLowValue = 10, SpinnerLowValue = 10,;
            Value = 100, Anchor = 9, Width = 60

      Procedure Load
            Declare Integer SetParent In user32;
                  INTEGER hWndChild,;
                  INTEGER hWndNewParent

            Declare Integer FindWindow In user32;
                  STRING lpClassName, String lpWindowName

            Declare Integer SetWindowPos In user32;
                  INTEGER HWnd,;
                  INTEGER hWndInsertAfter,;
                  INTEGER x,;
                  INTEGER Y,;
                  INTEGER cx,;
                  INTEGER cy,;
                  INTEGER uFlags

            Declare Integer GetWindowLong In User32;
                  Integer HWnd, Integer nIndex

            Declare Integer SetWindowLong In user32 ;
                  Integer HWnd,;
                  INTEGER nIndex,;
                  Integer dwNewLong
      Endproc

      Procedure Resize
            Thisform._SetCoord()
      Endproc

      Procedure Destroy
            If Type('thisform._oexcel') = 'O'
                  This._Clear()
            Endif
      Endproc

      Procedure cmdOpen.Click
            If Type('thisform._oexcel') = 'O'
                  Thisform._Clear()
            Endif
            Thisform._linkapp()
      Endproc

      Procedure cmdSave.Click
            If Type('thisform._oexcel') = 'O'
                  Thisform._oExcel.activeworkbook.Save()
                  Messagebox('Changes made are saved!',64,'Save')
            Else
                  Messagebox('Nothing to save yet!',64,'Opppppssss!')
            Endif
      Endproc

      Procedure cmdClose.Click
            If Type('thisform._oexcel') = 'O'
                  Thisform._Clear()
            Endif
      Endproc

      Procedure SpinZoom.InteractiveChange
            Thisform._oExcel.ActiveWindow.Zoom=Thisform.SpinZoom.Value
      Endproc

      Procedure chkShowTabs.Click
            Thisform._oExcel.ActiveWindow.DisplayWorkbookTabs=This.Value
      Endproc

      Procedure _Clear
            With This
                  With  .Shape1
                        * Show shape
                        .Visible = .T.
                        * Hide window via uFlags
                        SetWindowPos(This._nHwnd, 1, .Left, .Top, .Width, .Height,0x0080)
                  Endwith

                  With ._oExcel
                        * Restore those we have hidden
                        .DisplayFormulaBar = .T.
                        .DisplayStatusBar = .T.
                        .ActiveWindow.DisplayWorkbookTabs=.T.
                        .ActiveWindow.DisplayHeadings=.T.

                        .activeworkbook.Close()
                        .Visible = .F.
                        .Quit
                  Endwith
                  ._oExcel = .F.
            Endwith
      Endproc

      Procedure _HideRibbon
            Local loRibbon
            loRibbon =This._oExcel.CommandBars.Item("Ribbon")
            If m.loRibbon.Height > 0
                  This._oExcel.ExecuteExcel4Macro('Show.Toolbar("Ribbon",False)')
            Endif
      Endproc

      Procedure _linkapp
            Local loExcel As excel.Application, lcFile
            loExcel = Createobject('excel.application')
            lcFile = Getfile('xls,xlsx')
            If !Empty(m.lcFile)
                  loExcel.Workbooks.Open(m.lcFile)

                  * This is so we can tap into it on other methods/events
                  This._oExcel = loExcel

                  With loExcel
                        .Visible = .T.
                        .DisplayAlerts = .F.
                        .Application.ShowWindowsInTaskbar=.F.

                        .DisplayFormulaBar = .F.
                        .DisplayDocumentActionTaskPane=.F.
                        .DisplayStatusBar = .F.

                        * Ensure scroll bars are shown
                        .ActiveWindow.DisplayVerticalScrollBar=.T.
                        .ActiveWindow.DisplayHorizontalScrollBar=.T.

                        * Hide Workbook Tabs
                        .ActiveWindow.DisplayWorkbookTabs=Thisform.chkShowTabs.Value

                        .ActiveWindow.DisplayHeadings=.F.
                        .ActiveWindow.WindowState = -4137  && xlMaximized
                        .ActiveWindow.Zoom=Thisform.SpinZoom.Value

                        * Get a handle on Window
                        nHwnd = FindWindow('XLMain', .Caption)
                  Endwith

                  * Add this so we can work on other methods
                  This._nHwnd = m.nHwnd

                  * Hide Ribbon
                  Thisform._HideRibbon()


                  * Hide the title bar, disallow drag and drop of the excel window
                  Local lnStyle

                  * Get the current style of the window
                  lnStyle = GetWindowLong(nHwnd, -6)

                  * Set the new style for the window
                  SetWindowLong(nHwnd, -16, Bitxor(lnStyle, 0x00400000))

                  * force it inside our form
                  SetParent(nHwnd,Thisform.HWnd)

                  * Size it
                  Thisform._SetCoord()

                  * Hide shape
                  Thisform.Shape1.Visible = .F.
            Endif
      Endproc

      Procedure _SetCoord
            * size it based on Invisible shape
            With This.Shape1
                  SetWindowPos(This._nHwnd, 0, .Left, .Top, .Width, .Height, 2)
            Endwith
      Endproc

Enddefine

Palabras de despedida:

En primer lugar, muchas gracias a Bernard Bout, cuya publicación me sirve de inspiración para este enfoque. Un agradecimiento especial a Yousfi Benameur quien nos compartió también antes de los códigos para ocultar la cinta de Excel en Office 2007.

Siempre que estoy haciendo este estilo de redacción, estoy apuntando a que los lectores que son nuevos en esto intenten comprender el propósito de cada paso / objeto / código. ¿Cuál es el propósito de WinExec aquí, por qué necesitamos conocer el título, cuál es el propósito de la forma en el formulario, etc.?

Otra es que mis lectores provienen de diferentes partes del mundo donde el inglés no es el idioma nativo y supongo que mi enfoque de redacción es una de las razones por las que mi Blog todavía recibe nuevas páginas vistas de vez en cuando. Aunque espero no aburrirte de esta manera. :)

Hora de dormir....


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

26 de marzo de 2020

Recorrer una planilla Excel desde VFP

Con este código podemos recorrer una Planilla de Excel desde Visual FoxPro y ver el contenido de todas sus celdas.

*-- Creo el objeto Excel
loExcel = CREATEOBJECT("Excel.Application")
WITH loExcel.APPLICATION
  .VISIBLE = .F.
  *-- Abro la planilla con datos
  .Workbooks.OPEN("C:\MiPlanilla.xls")
  *-- Cantidad de columnas
  lnCol = .ActiveSheet.UsedRange.COLUMNS.COUNT
  *-- Cantidad de filas
  lnFil = .ActiveSheet.UsedRange.ROWS.COUNT
  *-- Recorro todas las celdas
  FOR lnI = 1 TO lnCol
    FOR lnJ = 1 TO lnFil
      ? CHR(lnI+64) + ALLTRIM(STR(lnJ)) + ': '
      ?? .activesheet.cells(lnJ,lnI).VALUE
    ENDFOR
  ENDFOR
  *-- Cierro la planilla
  .Workbooks.CLOSE
  *-- Salgo de Excel
  .Quit
ENDWITH
RELEASE loExcel

Al recorrerla también podemos cambiar los valores de las celdas, solo deberiamos guardar los cambios antes de cerrar la planilla con:

loExcel.APPLICATION.activeworkbook.SAVE

8 de agosto de 2018

Copiar todo el contenido de un GRID a una hoja de cálculo de Excel

A veces puede ser cómodo utilizar VFP para calcular, extraer o preparar una vista, la cual puede ser visualizada utilizando un GRID. Pero no hay duda que una hoja de cálculo de Excel ofrece muchas mas posibilidades para elaborar, analizar y estudiar los datos preparados, o simplemente el usuario a veces sabe manejar bien Excel y prefiere usar esta herramienta.

VFP tiene una gran integración con estos sistemas y veremos lo fácil que es copiar el contenido de un GRID en una hoja de Excel.

Lo único que necesitamos es unas pocas líneas de código que podríamos poner, por ejemplo, en el evento click de un botón. Imaginando que el botón esté en el mismo formulario que el grid, el código será el siguiente:

LOCAL cErrores, lExcel

* BUSCO UNA SESION DE EXCEL YA ACTIVA:
cErrores = ON("ERROR")
ON ERROR lExcel = .F.
oExcel = GetObject(,"excel.application")
ON ERROR &cErrores

IF TYPE("oExcel")    * NO ESTABA ACTIVA. PREPARO UNA NUEVA SESION DE EXCEL:
   oExcel = CREATEOBJECT("Excel.Application")
ENDIF
oExcel.VISIBLE = .T.    && VISUALIZO EXCEL
oExcel.Workbooks.ADD    && PREPARO UN NUEVO TRABAJO DE EXCEL

SELE (THISFORM.GRID1.RECORDSOURCE)
GO TOP
nRows = 0
* EMPIEZO A CARGAR LA HOJA DE EXCEL LEYENDO LA ESTRUCTURA DEL GRID:
WITH THISFORM.GRID1
   SCAN
      nRows = nRows + 1
      FOR nColumn = 1 TO .COLUMNCOUNT
         oExcel.Cells(nRows,nColumn) = EVAL(.COLUMNS(nColumn).CONTROLSOURCE)
      NEXT nColumn
   ENDSCAN
ENDWITH

Pablo Roca

23 de abril de 2018

Copiar una grafica de Excel y pegarla en una diapositiva de PowerPoint

El Objetivo del siguiente código es abrir un libro de Excel y una presentación de PowerPoint, copiar un Grafico (Gráfico 2) el cual se encuentra en la primera hoja del libro y luego pegarlo en la diapositiva 19 de la presentación.

*!* Abrimos el archivo de Excel y de power point
lcArchivoExcel=GETFILE("xls","Abrir archivo de Excel")
lcArchivoPower=GETFILE("ppt","Abrir archivo de Power")

*!* Comprobamos que existan
IF FILE(lcArchivoExcel)==.F. OR FILE(lcArchivoPower)==.F.
  =MESSAGEBOX("Los archivo o alguno no existe",16,"File==.f.")
  RETURN
ENDIF

*!* Obejtios de Excel
loXlsApp = CREATEOBJECT("Excel.Application")
loXlsBook=loXlsApp.Workbooks.OPEN(lcArchivoExcel)
loXlsApp.VISIBLE = .T.
loXlsSheet = loXlsBook.Sheets(1)

*!* Seleccionando Grafica y Copiando
loGraficoXls = loXlsSheet.ChartObjects("Gráfico 2")
loGraficoXls.COPY()

*!* Objetos de Power Point
loPptApp = CREATEOBJECT("Powerpoint.Application")
loPptApp.VISIBLE= .T.
loPptPresentacion = loPptApp.Presentations.OPEN(lcArchivoPower)
loPptSlide=loPptPresentacion.Slides(19)
loPptSlide.SELECT()

*!* Pegamos Objeto
loGraficoPpt=loPptSlide.Shapes.Paste()

*!* Movemos el Grafico al centro
WITH loPptSlide.Shapes(loGraficoPpt.NAME)
  .IncrementLeft(-521.75)
  .IncrementTop(104.12)
ENDWITH

Jose Guillermo Ortiz Hernandez

21 de abril de 2018

Copiar celdas de una Hoja de calculo (Excel) y pegarlas en una diapositiva (PowerPoint)

El siguiente ejemplo muestra como copiar celdas existentes en un libro de excel y copiarlas en una diapositiva de una presentacion de Power Point. En este ejmplo se supone que el libro y la presentacion ya existen.

LOCAL loXlsApp, loXlsBook, loXlsSheet, loPptApp, loPptPresentacion, loPptSlide

*!* ARCHIVOS ORIGEN
*!* Archivo de Excel en donde estan los datos
*!* Comprobamos que exista el archivo, de no existir lo abrimos
lcArchivoExcel="datos.xls"
lcArchivoExcel=IIF(!FILE(lcArchivoExcel),GETFILE("xls"),lcArchivoExcel)

*!* Archivo de Power Point donde deseamos pegar los datos
*!* Nuevamente comprobamos si existe el archivo o si hay que buscarlo
lcArchivoPower="presentacion.ppt"
lcArchivoPower=IIF(!FILE(lcArchivoPower),GETFILE("ppt"),lcArchivoPower)

*!* INICIANDO PROCESO DE COPY -> PASTE
IF FILE(lcArchivoExcel) AND FILE(lcArchivoPower)

  *!* COPIANDO DATOS DE EXCEL AL CLIPBOARD
  loXlsApp = CREATEOBJECT("Excel.Application")
  loXlsApp.VISIBLE = .T.
  loXlsBook=loXlsApp.Workbooks.OPEN(lcArchivoExcel)
  loXlsSheet = loXlsBook.Sheets(3)
  loXlsSheet.RANGE("A1:I23").COPY()

  *!* PEGANDO DATOS DESDE EL CLIPBOARD A DIAPOSITIVA
  loPptApp = CREATEOBJECT("Powerpoint.Application")
  loPptApp.VISIBLE= .T.
  loPptPresentacion = loPptApp.Presentations.OPEN(lcArchivoPower)
  loPptSlide=loPptPresentacion.Slides(18)
  loPptSlide.SELECT()
  loPptApp.ActiveWindow.VIEW.Paste()
ELSE
  =MESSAGEBOX("Los archvios de Excel y Power no existen",0+64+0,"No existen")
ENDIF

Jose Guillermo Ortiz Hernandez

23 de noviembre de 2017

Importar desde Excel a un Cursor actualizable

La rutina abre un libro de Excel y lo pasa a un cursor tomando la primera fila como los encabezados de las columnas.

LOCAL lcXLSBook AS STRING

lcXLSBook = GETFILE('xls, xlsx', 'Archivo:', 'Aceptar', 0, 'Seleccione una hoja de cálculo')
IF EMPTY(lcXLSBook)
  RETURN .F.
ENDIF

ExcelToCursor(m.lcXLSBook, "xlsResult")

SELECT xlsResult
BROWSE NOWAIT

*!------------------------------------------------------------------------------
*! Procedure : ExcelToCursor
*! Parametros: pcSrcFile -> Nombre del libro de excel
*!             pcCursorName -> Nombre del cursor
*!------------------------------------------------------------------------------
PROCEDURE ExcelToCursor(pcSrcFile AS STRING, pcCursorName AS STRING)
  IF PCOUNT() = 0
    RETURN .F.
  ELSE
    IF VARTYPE("pcSrcFile")#"C"
      RETURN .F.
    ENDIF

    IF !FILE(pcSrcFile)
      MESSAGEBOX("Archivo no encontrado", 16)
      RETURN .F.
    ENDIF

    IF VARTYPE("pcCursorName")#"C"
      RETURN .F.
    ENDIF
  ENDIF

  *** Instanciar MS Excel
  LOCAL oExcel AS Excel.APPLICATION
  m.oExcel = CREATEOBJECT("Excel.application")

  IF VARTYPE(oExcel,.T.)!='O'
    MESSAGEBOX("No se puede procesar el archivo." ;
      + CHR(13) + "Microsoft Excel no está instalado en su ordenador.", 16)
    m.oExcel = NULL
    RELEASE oExcel
    RETURN .F.
  ENDIF

  *** Abrir archivo de Excel
  m.oExcel.Workbooks.OPEN(pcSrcFile)
  m.oExcel.Worksheets(1).ACTIVATE
  m.oExcel.DisplayAlerts = .F.

  LOCAL oSheet AS OBJECT
  m.oSheet = m.oExcel.ActiveSheet

  LOCAL aExcel(1), laStructure(1)
  LOCAL lnCol, lnRow, lnSize, lcCol, lcRow, lcValue, lcCmd

  *** Redimensionar aExcel de acuerdo a las filas y columnas que
  *** contiene el libro de excel abierto
  IF EVALUATE("ALEN(aExcel)") # m.oSheet.UsedRange.COLUMNS.COUNT
    DIMENSION aExcel [1, m.oSheet.UsedRange.Columns.Count]
  ENDIF

  m.lnCol = m.oSheet.UsedRange.COLUMNS.COUNT
  m.lnRow = m.oSheet.UsedRange.ROWS.COUNT

  *** Pasar los valores del libro de excel
  *** a la matriz redimensionada aExcel
  TEXT TO lcCmd TEXTMERGE NOSHOW PRETEXT 1+2
  aExcel = m.oExcel.ActiveWorkbook.ActiveSheet.Range(m.oSheet.Cells(1,1), m.oSheet.Cells(<<m.lnRow>>,<<m.lnCol>>)).value
  ENDTEXT
  &lcCmd

  *** Cerrar la instancia MS Excel
  m.oExcel.QUIT()
  m.oExcel = NULL
  RELEASE oExcel, oSheet

  *** Procedimiento para determinar los tipo de datos por
  *** columnas y crear la estructura del cursor
  m.lnRow = ALEN(aExcel,1)
  m.lnCol = IIF(ALEN(aExcel,2)>0, ALEN(aExcel,2), 1)

  *** La matriz laStructure bidimensional
  *** almacena la estructura del cursor
  *** Columna 1 -> Nombre de la columna
  *** Columna 2 -> Tipo de datos
  *** Columna 3 -> Largo
  *** Columna 4 -> Decimal
  *** Columna 5 -> Acepta valores null
  DIMENSION laStructure(m.lnCol,5)

  FOR i = 1 TO m.lnCol
    m.lnSize = 1
    m.lcCol = LTRIM(STR(i))
    laStructure(i,1) = aExcel(1,i)
    laStructure(i,2) = VARTYPE(aExcel(2,i))
    DO CASE
      CASE laStructure(i,2) = "C" && Character, Memo, Varchar, Varchar (Binary)
        FOR j = 1 TO m.lnRow
          m.lcValue = IIF(m.lnCol = 1, TRANSFORM(aExcel(j)), TRANSFORM(aExcel(j,i)))
          m.lnSize = MAX(m.lnSize, LEN(TRANSFORM(aExcel(j,i))))
          IF AT(CHR(13), m.lcValue) > 0
            laStructure(i,2) = "M" && Memo
          ENDIF
        ENDFOR

        IF laStructure(i,2) = "C"  && Character, Varchar
          IF lnSize < 10
            laStructure(i,3) = 10
          ELSE
            laStructure(i,3) = lnSize
          ENDIF
          laStructure(i,4) = 0
        ELSE            && Memo, Blob
          laStructure(i,3) = 4
          laStructure(i,4) = 0
        ENDIF

      CASE laStructure(i,2) = "D" OR laStructure(i,2) = "T" && Date, DateTime
        laStructure(i,3) = 8
        laStructure(i,4) = 0

      CASE laStructure(i,2) = "L" && Logical
        laStructure(i,3) = 1
        laStructure(i,4) = 0

      CASE laStructure(i,2) = "N" && Numeric, Float, Double, o Integer
        laStructure(i,3) = 12
        laStructure(i,4) = 2

      OTHERWISE
    ENDCASE
    laStructure(i,5) = .T.
  ENDFOR

  *** Crear el cursor
  CREATE CURSOR &pcCursorName FROM ARRAY laStructure

  *** Insertar en el cursor los valores desde aExcel
  LOCAL lCellValue
  m.lcRow = ""

  FOR i = 1 TO m.lnRow
    FOR j = 1 TO m.lnCol
      IF !EMPTY(m.lcRow)
        m.lcRow = m.lcRow + ", "
      ENDIF

      lCellValue = EVALUATE([aExcel(i,j)])
      DO CASE
        CASE VARTYPE(lCellValue) = "C" && Character, Memo, Varchar, Varchar (Binary)
          IF !EMPTY(lCellValue) OR lCellValue # ""
            m.lcRow = m.lcRow + ['] + EVALUATE([aExcel(i,j)]) + [']
          ELSE
            m.lcRow = m.lcRow + [Null]
          ENDIF

        CASE VARTYPE(lCellValue) = "D" OR VARTYPE(lCellValue) = "T" && Date, DateTime
          m.lcRow = m.lcRow + [{] + EVALUATE([aExcel(i,j)]) + [}]

        CASE VARTYPE(lCellValue) = "N" && Numeric, Float, Double, o Integer
          m.lcRow = m.lcRow + ALLTRIM(STR(EVALUATE([aExcel(i,j)])))

        OTHERWISE
          m.lcRow = m.lcRow + EVALUATE([aExcel(i,j)])
      ENDCASE
    ENDFOR

    IF i > 1
      TEXT TO cSQL TEXTMERGE NOSHOW PRETEXT 1+2
    Insert Into <<pcCursorName>> Values (<<lcRow>>)
      ENDTEXT
      EXECSCRIPT(cSQL)
    ENDIF

    m.lcRow = ""
  ENDFOR

  *** Liberar variables
  RELEASE pcSrcFile, laStructure, lnSize, lcValue, lcCmd
  RELEASE lCellValue, aExcel, lnCol, lnRow, lcCol, lcRow, cSQL, i, j

  SELECT &pcCursorName
  GO TOP

  *** Retornar el cursor
  RETURN SETRESULTSET(pcCursorName)
ENDPROC

Hector Urrutia

14 de junio de 2016

Buscar y Reemplazar en un documento Word

Ejemplo de buscar y reemplazar en un documento Word

wordFindAndreplace("foxpro","FoxPro","c:\informe.doc")

FUNCTION wordFindAndReplace
  LPARAMETERS cValueTofind,cValueToreplace,cDocument
  LOCAL lValue
  oWord = CREATEOBJECT("word.application")
  oDocument = oWord.Documents.OPEN(cDocument)
  loSelection = oWord.SELECTION
  WITH loSelection.FIND
    .TEXT = cValueToFind
    .Forward = .T.
    .WRAP= 1
  ENDWITH
  DO WHILE .T.
    lValue = loSelection.FIND.Execute
    IF lValue
      loSelection.Cut
      loSelection.InsertBefore(cValueToReplace)
      loselection.MoveRight
    ELSE
      EXIT
    ENDIF
  ENDDO
  oWord.VISIBLE =.T.
ENDFUNC

Mauricio Henao Romero

6 de abril de 2016

Crear una hoja de Excel con SubTotales

Con el siguiente código y utilizando Automation, podemos crear una hoja Excel con SubTotales. Cortesía de Çetin Basöz, MVP de VFP.

OPEN DATABASE (HOME(2) + "Northwind\Northwind.dbc")
SELECT o.CustomerId, o.OrderId, ProductId, UnitPrice, Quantity ;
  FROM Orders o inner JOIN OrderDetails od ON o.OrderId = od.OrderId ;
  ORDER BY o.CustomerId, o.OrderId ;
  INTO CURSOR crsTemp
lcXLSFile = SYS(5) + CURDIR() + "myOrders1.xls"
COPY TO (lcXLSFile) TYPE XLS
CLOSE DATABASES ALL
DIMENSION laSubtotal[3]
laSubtotal[1] = 4 && Unit_price
laSubtotal[2] = 5 && Quantity
laSubtotal[3] = 6 && Will use later
#DEFINE xlSum -4157
oExcel = CREATEOBJECT("excel.application")
WITH oExcel
  .Workbooks.OPEN(lcXLSFile)
  WITH .ActiveWorkbook.ActiveSheet
    lnRows = .UsedRange.ROWS.COUNT && Get current row count
    lcFirstUnusedColumn = _GetChar(laSubtotal[3]) && Get column in Excel A1 notation
    * Instead of orders order_net field use Excel calculation for net prices
    .RANGE(lcFirstUnusedColumn + '2:' + ;
      lcFirstUnusedColumn + TRANSFORM(lnRows)).FormulaR1C1 = ;
      "=RC[-2]*RC[-1]"
    .RANGE(lcFirstUnusedColumn+'1').VALUE = 'Extended Price' && Place header
    .RANGE('D:'+lcFirstUnusedColumn).NumberFormat = "$#,##0.0000" && Format columns
    * Subtotal grouping by customer then by order
    .UsedRange.Subtotal(1, xlSum, @laSubtotal)
    .UsedRange.Subtotal(2, xlSum, @laSubtotal,.F.,.F.,.F.)
    .UsedRange.COLUMNS.AUTOFIT && Autofit columns
  ENDWITH
  .VISIBLE = .T.
ENDWITH
* Return A, AA, BC etc notation for nth column
FUNCTION _GetChar
  LPARAMETERS tnColumn && Convert tnValue to Excel alpha notation
  IF tnColumn = 0
    RETURN ""
  ENDIF
  IF tnColumn <= 26
    RETURN CHR(ASC("A") - 1 + tnColumn)
  ELSE
    RETURN  _GetChar(INT(IIF(tnColumn % 26 = 0, tnColumn - 1, tnColumn) / 26)) + ;
      _GetChar((tnColumn-1) % 26 + 1)
  ENDIF
ENDFUNC

Çetin Basöz
MS Foxpro MVP, MCP

30 de octubre de 2015

Insertar una imagen en Excel

Desde VFP y con Automation, insertamos una imagen en Excel y le configuramos su tamaño.

LOCAL lcImagen, lcPlanilla, lo
*-- Selecciono imagen y nombre de planilla (xls)
lcImagen = GETPICT()
lcPlanilla = PUTFILE("Nombre","MiPlanilla","xls")
*-- Creo objeto Excel
lo = CREATEOBJECT("Excel.Application")
*-- Añado un libro nuevo
lo.Workbooks.Add
*-- Selecciono la celda donde estará la posición de la imagen
lo.Cells(3,3).Select
lo.ActiveSheet.Pictures.Insert(lcImagen).Select
lo.Selection.ShapeRange.LockAspectRatio = 0
lo.Selection.ShapeRange.Height = 320 && pixeles
lo.Selection.ShapeRange.Width = 240 && pixeles
*-- Guardo planilla
lo.ActiveWorkbook.SaveAs(lcPlanilla)
lo.Quit
lo = .Null.

Luis María Guayán

28 de octubre de 2015

MS-Excel Automation y OLEDB a través de Visual FoxPro

Una manera más de llevar registros hacia Excel, esta vez usando OLEDB. Cortesía de Çetin Basöz, MVP de VFP.

Local oRS as AdoDB.Recordset,oRS2 as AdoDB.Recordset,oCon as AdoDB.Connection
oCon = CreateObject('ADODB.connection')
oCon.ConnectionString = "Provider=VFPOLEDB;Data Source="+_samples+"data\testdata.dbc"
oCon.Open
oRS = oCon.Execute('select * from employee')
oRs.Save('disconnectme.rst')

oRS2 = CreateObject('ADODB.Recordset')
oRs2.Open('disconnectme.rst')

oExcel = Createobject('Excel.Application')
With oExcel
  .Workbooks.Add
  .Visible = .T.
  .ActiveWorkbook.ActiveSheet.QueryTables.Add( oRS2, .Range("A1")).Refresh
Endwith
Erase 'disconnectme.rst'

Nota del editor: Lo anterior no se limita a extracción de datos de Visual FoxPro, puede ser para cualquier otro manejador de base de datos del cual se tenga un OLEDB Provider instalado (MS-SQLServer, MySQL, PostgreSQL, Oracle, etc).

Çetin Basöz
MS Foxpro MVP, MCP

18 de octubre de 2015

Ventana de Word y Excel en primer plano

Si necesitamos poner una ventana de Microsoft Excel en primer plano mediante Automation podemos utilizar el siguiente código VFP:

lcXls = GETFILE("XLS")
IF NOT EMPTY(lcXls) AND FILE(lcXls)
  loExcel = CREATEOBJECT("Excel.Application")
  loExcel.Workbooks.OPEN(lcXls)
  loExcel.VISIBLE = .T.
  DECLARE LONG BringWindowToTop IN "user32" LONG HWND
  BringWindowToTop(loExcel.HWND)
ELSE
  MESSAGEBOX("El archivo " + lcXls + " no existe", 0+16, "Aviso")
ENDIF

Para el caso de Microsoft Word que no tiene la propiedad hWnd (window handle -identificador de ventana-), primeramente debemos buscar ese handle:

lcDoc = GETFILE("Doc")
IF NOT EMPTY(lcDoc) AND FILE(lcDoc)
  loWord = CREATEOBJECT("Word.Application")
  loWord.Documents.OPEN(lcDoc)
  loWord.VISIBLE = .T.
  lcCaption = loWord.ActiveDocument.ActiveWindow.Caption + [ - Microsoft Word]
 DECLARE integer FindWindow IN "user32" String, String
  lnHWnd = FindWindow(Null , lcCaption)
  DECLARE LONG BringWindowToTop IN "user32" LONG HWND
  BringWindowToTop(lnHWND)
ELSE
  MESSAGEBOX("El archivo " + lcDoc + " no existe", 0+16, "Aviso")
ENDIF

Luis Maria Guayan

9 de julio de 2015

Importar datos de Excel en tablas VFP

Anteriormente baje una rutina para mostrar el contenido de las celdas en excel. Modifique un poco el codigo de tal forma que teniendo una Hoja Excel donde la primera linea contiene los nombre de los campos de una tabla VFP y las siguientes los datos a importar.

La rutina modificada, lee el nombre de campo en la primera fila Y lo compara con la de la tabla existente PARA poder saber que tipo de datos es el esperado realizando las transformaciones requeridas.

(No recuerdo que publico el codigo original, asi es que disculpas al autor original)

**** Importar Masivo desde Excel
* Poner en Primera Fila los Nombres de Campo, los que se 
* chequearan que coincidan en la tabla
* Modificado por Ludwig Corales M.
* 28/08/2009
CLEAR
xArchivo="C:\temp\santa_maría.xls"
xTabla="Planos"  &&Tabla destino
IF USED("&xTabla")  &&Verifica que no este en uso la tabla
  SELECT("&xTabla")
  USE
ENDIF
USE &xTabla IN 0

*-- Creo el objeto Excel
loExcel = CREATEOBJECT("Excel.Application")
WITH loExcel.APPLICATION
  .VISIBLE = .F.
  *-- Abro la planilla con datos
  .Workbooks.OPEN("&xArchivo")
  *-- Cantidad de columnas
  lnCol = .ActiveSheet.UsedRange.COLUMNS.COUNT
  *-- Cantidad de filas
  * Se resta la Fila 1 donde estan los campos
  lnFil = .ActiveSheet.UsedRange.ROWS.COUNT-1
  *-- Recorro todas las celdas
  ** el Recorrido es columnas y luego filas
  FOR lnJ = 2 TO lnFil
    SELECT("&xTabla")
    APPEND BLANK   && se inserta el nuevo registro
    FOR lnI = 1 TO lnCol
      xCampo=.activesheet.cells(1,lnI).VALUE  && Nombre del campo destino
      xTipoCampo=TYPE(xCampo)  && se obtiene de la tabla el tipo de campo
      xValor=.activesheet.cells(lnJ,lnI).VALUE  && Recupera el valor de la Celda en Excel
      *? xcampo+": "  && Muestra el nombre de campo
      *?? xValor         && Muestra el valor
      DO CASE
        CASE xTipoCampo="D"  && si el campo es de fecha
          IF ISNULL(xValor)  &&Es fecha en blanco o nulo
            REPLACE &xCampo WITH CTOD("  /  /  ") IN &xTabla
          ELSE
            REPLACE &xCampo WITH TTOD(xValor) IN &xTabla
          ENDIF
        CASE xTipoCampo="C"
          IF VARTYPE(xValor)="N"  && por si en excel el valor no es TEXT
            REPLACE &xCampo WITH ALLTRIM(UPPER(STR(xValor))) IN &xTabla
          ELSE
            REPLACE &xCampo WITH xValor IN &xTabla
          ENDIF
        CASE xTipoCampo="N"
          IF ISNULL(xValor)
            REPLACE &xCampo WITH 0 IN &xTabla
          ELSE
            REPLACE &xCampo WITH xValor IN &xTabla
          ENDIF

      ENDCASE
    ENDFOR
  ENDFOR
  *-- Cierro la planilla
  .Workbooks.CLOSE
  *-- Salgo de Excel
  .QUIT
ENDWITH
RELEASE loExcel
SELECT("&xTabla")
BROWSE
**** Fin del Codigo

Salu2

Ludwig

8 de noviembre de 2014

Automatizando Visual FoxPro

Así como podemos controlar otras aplicaciones desde Visual FoxPro mediante automatización, también podemos controlar Visual FoxPro desde otras aplicaciones utilizando a VFP como un servidor de automatización.

Existen muchos escritos sobre como automatizar aplicaciones como Excel, Word, Outlook, etc. desde Visual FoxPro como cliente de automatización, pero quizás algo que muchos desconozcan, es que Visual FoxPro también es un servidor de automatización. ¿Que quiero decir con esto?. Que cualquier aplicación que permita automatización puede crear una instancia de Visual FoxPro y ejecutar comandos de Visual FoxPro.

Comenzar con lo conocido

Para comenzar utilizaremos a Visual FoxPro como cliente, como lo hicimos ya muchas veces, y crearemos una nueva instancia de Visual FoxPro con la siguiente sentencia:
loVFP = CREATEOBJECT("VisualFoxPro.Application")
Una vez creado el objeto Application de Visual FoxPro, con la ayuda de IntelliSense, una ventana emergente nos mostrará las Propiedades y los Métodos de este objeto al escribir lo siguiente:
loVFP.    
Si en la PC tenemos instaldas mas de una versión de Visual FoxPro, podemos especificar cual versión vamos a instanciar, como lo muestra el siguiente código:
*-- Visual FoxPro 9.0
loVFPx = CREATEOBJECT("VisualFoxPro.Application.9")
? loVFPx.Version
loVFPx.Quit

*-- Visual FoxPro 8.0
loVFPx = CREATEOBJECT("VisualFoxPro.Application.8")
? loVFPx.Version
loVFPx.Quit

*-- Visual FoxPro 7.0
loVFPx = CREATEOBJECT("VisualFoxPro.Application.7")
? loVFPx.Version
loVFPx.Quit

*-- Visual FoxPro 6.0
loVFPx = CREATEOBJECT("VisualFoxPro.Application.6")
? loVFPx.Version
loVFPx.Quit

Conocer los métodos y las propiedades

Algunos de los métodos disponibles del objeto Application de Visual Fox y que podemos ejecutar son:
  • DoCmd
Ejecuta un comando de Visual FoxPro para la instancia de la aplicación Visual FoxPro.
loVFP.DoCmd("USE (HOME(2)+'Northwind\Customers')")
  • Eval
Evalua y retorna el resultado de una expresión en la instancia de la aplicación Visual FoxPro.
? loVFP.Eval("CompanyName")
  • SetVar
Crea una variable y le asigna un valor en la instancia de la aplicación Visual FoxPro.
loVFP.SetVar("lcNombre","PortalFox")
? loVFP.Eval("lcNombre")
  • RequestData
Retorna una matriz que contiene los datos de una tabla abierta en la instancia de la aplicación Visual FoxPro.
laArray = loVFP.RequestData("Customers",2)
DISPLAY MEMORY LIKE laArray
  • DataToClip
Copia como texto al portapapeles un conjunto de registros de una tabla abierta en la instancia de la aplicación Visual FoxPro.
loVFP.DataToClip("Customers",2,3)
? ClipText
  • Quit
Finaliza la instancia de la aplicación Visual FoxPro.
loVFP.Quit
Algunas de la propiedades del objeto Application de VFP y que podemos consultar o modificar son:
? loVFP.Version 
? loVFP.StartMode
loVFP.Caption = "Instanciado de otra aplicacion"
loVFP.Visible = .T.
La variable del sistema _VFP hace referencia al objeto aplicación de la instancia actual de Visual FoxPro, y podemos ejecutar sus métodos y modificar sus propiedades:
_VFP.Caption = "Instancia Actual de VFP"
_VFP.DoCmd("_Screen.BackColor = RGB(255,255,192)")
? _VFP.Version

Instanciando Visual FoxPro desde Excel

El siguiente ejemplo, nos muestra como podemos crear una instancia de Visual FoxPor desde Excel, abrir una tabla, e importar sus datos en una hoja de Excel.

Copie el siguiente código escrito en VBA (Visual Basic for Applications), insertelo en un módulo de Excel y ejecutelo:

Sub ImportarDeVFP()
   Dim loVFP As Object, lnReg As Integer
   Set loVFP = CreateObject("VisualFoxPro.Application")
   loVFP.DoCmd ("OPEN DATABASE (HOME(2)+'Northwind\Northwind')")
   loVFP.DoCmd ("SELECT * FROM Customers INTO CURSOR MiCursor")
   lnReg = loVFP.DataToClip("MiCursor", , 3)
   Range("A1").Select
   ActiveSheet.Paste
   Cells.Select
   Cells.EntireColumn.AutoFit
   loVFP.Quit
   Set loVFP = Nothing
   MsgBox (lnReg & " Registros copiados")
End Sub

Para terminar

Con este último ejemplo podemos ver que a veces es mas simple programar otra aplicación para controlar a Visual FoxPro y obtener datos, que hacerlo todo desde Visual FoxPro. Uds. verán el camino a tomar para dar solución a los requerimientos de los usuarios.

Hasta la próxima.

Luis María Guayán

15 de marzo de 2011

Saber la versión de un Libro de Excel

Con esta función podemos saber la versión con que fue guardado un libro de Excel.
lc = GETFILE("xls*")
? VersionLibroExcel(lc)

FUNCTION VersionLibroExcel(tcFile)
  LOCAL ln, lcFormat, lo
  IF NOT EMPTY(tcFile)
    lo = CREATEOBJECT("Excel.Application")
    lo.Workbooks.OPEN(tcFile)
    ln = lo.ActiveWorkbook.FileFormat
    DO CASE
      CASE ln = 16
        lcFormat = "Excel 2"
      CASE ln = 29
        lcFormat = "Excel 3"
      CASE ln = 33
        lcFormat = "Excel 4"
      CASE ln = 39
        lcFormat = "Excel 5 y 95"
      CASE ln = 43
        lcFormat = "Excel 97-2003 (Guardado desde 2003)"
      CASE ln = 51
        lcFormat = "Excel 2007-2010"
      CASE ln = 56
        lcFormat = "Excel 97-2003 (Guardado desde 2007-2010)"
      CASE ln = -4143
        lcFormat = "Excel 97, 2000, 2002 y 2003"
      OTHERWISE
        lcFormat = "Otro Formato # " + TRANSFORM(ln)
    ENDCASE
    lo.ActiveWorkbook.Close(.F.)
    lo.Quit
    lo = Null
  ELSE
    lcFormat = "No se especifico archivo"
  ENDIF
  RETURN lcFormat
ENDFUNC
Luis María Guayán

6 de septiembre de 2009

VFP y la Automatización de Outlook

Introducción

Me motivó a escribir este artículo el haber visto desde hace algún tiempo (ay, desde hace BASTANTE tiempo), centenas (o millares) de mensajes en el Grupo FoxBrasil sobre el tema "¿Cómo envío un email desde VFP?".

Quienes me conocen del Grupo saben que adoro estudiar, investigar, y principalmente usar, OLE Automation. Pero veamos, ¿qué significa esta sigla? OLE son las iniciales de Object Linking and Embedding. Formidable, ¿y esto qué es?, dirá usted. OLE Automation es la posibilidad que determinadas aplicaciones tienen de exponer su funcionamiento (PEMs: propiedades, eventos y métodos) a otra aplicación cualquiera. Es como si pudiésemos, por ejemplo, empaquetar Microsoft Word como un objeto e incluirlo dentro de nuestra aplicación VFP (o VB, o VBA, o JavaScript, etc).

Digamos que en un sistema para controlar la suscripción a una revista, es necesario recordar al responsable del sector de cobranzas que un día determinado debe verificar que las cuotas de los suscriptores han sido pagadas. Ese día no es fijo para todos los suscriptores, sino que es determinado por la fecha de suscripción. Así que deberíamos montar una agenda dentro de nuestro sistema para que esta persona sea avisada, ¿verdad? No necesariamente, ya que esta persona utiliza Outlook 2000, y Outlook 2000 es un servidor OLE; o sea que podemos, dentro de VFP, manipular el Outlook 2000 y ejecutar una determinada tarea, tal como abrir una entrada en el calendario, introducir los datos necesarios y guardarlos. P> ¿Es fácil? No, no lo es hasta que tenga en sus manos la documentación del servidor OLE (el Modelo de Objetos) y (en muchas oportunidades) ésta es la tarea más ardua.

Pretendo, de acuerdo a mi tiempo libre y a la paciencia de mi familia, escribir una serie de artículos sobre el Modelo de Objetos de Microsoft Outlook, Internet Explorer y Lotus Notes, aunque como comencé a estudiar éste último hace poco, no se si será posible. Por motivos didácticos, comenzaremos esta serie de artículos por Outlook, y me gustaría aclarar que esta serie está basada en otra, escrita por Andrew Ross MacNeill para la revista FoxPro Advisor.

Microsoft Outlook

Outlook es una herramienta de productividad que incluye Calendario, Correo electrónico (e-mail), Contactos y Tareas (como ítems principales). Utilizo la versión más reciente, Outlook 2000, así que todas las referencias serán en relación a esta versión. El Modelo de Objetos de Outlook 2000 puede ser consultado en el archivo VBAOUTL9.CHM. Si no lo tiene instalado, envíeme un mensaje y se lo haré llegar. Como se puede ver en la Figura 1, el objeto Application es el primero de la jerarquía. Ese objeto no sirve para mucho, pero es la puerta de entrada. Aunque Outlook sea usado para una serie de cosas, es primordialmente un paquete de e-mail. Por esta razón, utiliza MAPI, Messaging Application Programming Interface.


Figura 1 - Modelo de Objetos de Microsoft Outlook 2000.

Al abrir Outlook, éste crea una referencia a un objeto MAPI NameSpace. Ese objeto almacena referencias a la ubicación de las Carpetas, ítems y configuraciones usadas por Outlook. ¿Saltamos al interior? Vamos, echemos una mirada a este código:

LOCAL loApplication, loNameSpace, loContacts, loInbox, lcMessage

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)
loInbox       = loNameSpace.GetDefaultFolder(6)

lcMessage     = "Nombre del Folder 'Contacts': " + CHR(9) + loContacts.Name + CHR(13) + CHR(10)+;
                "Nombre del Folder 'Inbox': "    + CHR(9) + loInbox.Name

MSGSVC(lcMessage)

RELEASE ALL

RETURN

Primero llamamos a Outlook y creamos el objeto NameSpace (siempre comenzamos así), después, usamos el método GetDefaultFolder para obtener una referencia (otro objeto) a algunos de los Folders (carpetas) más usados y, finalmente, mostramos sus nombres. La Tabla 1 muestra la lista de parámetros posibles para el método GetDefaultFolder.

Parámetro Folder
3 Deleted Items (Elementos eliminados)
4 OutBox (Bandeja de salida)
5 Sent Items (Elementos enviados)
6 Inbox (Bandeja de entrada)
9 Calendar (Calendario)
10 Contacts (Contactos)
11 Journal (Diario)
12 Notes (Notas)
13 Tasks (Tareas)
16 Drafts (Borrador)

Esta estrategia funciona bien con los Folders "padre", pero ¿si deseamos saber el contenido de la Bandeja de entrada? Para eso vamos a usar la propiedad Folders que todo objeto Folder posee. Vea el siguiente ejemplo:

LOCAL loApplication, loNameSpace, loInbox, lnContador, loFolder

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loInbox       = loNameSpace.GetDefaultFolder(6)

FOR lnContador = 1 TO loInbox.Folders.Count

    loFolder = loInbox.Folders(lnContador)
 
    MSGSVC("Folder: " + loFolder.Name)

ENDFOR

RELEASE ALL

RETURN

Primero seleccionamos la Bandeja de entrada, verificamos el número de Folders contenidos y mostramos sus nombres. Es bueno recordar que podemos hacer referencia a un Folder por su número (Folders(4)) o por su nombre (Folders("Bandeja de entrada")).

Cada Folder tiene una colección de ítems. Use la propiedad Count para saber el número de ítems. Así podemos modificar ligeramente nuestro programa para que también muestre el número de ítems contenidos en cada Folder:

LOCAL loApplication, loNameSpace, loInbox, lnContador, loFolder, lcMensagem

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loInbox       = loNameSpace.GetDefaultFolder(6)

FOR lnContador = 1 TO loInbox.Folders.Count

    loFolder   = loInbox.Folders(lnContador)
 
    lcMensagem = "Folder: " + CHR(9) + loFolder.Name + CHR(13) + CHR(10) +;
                 "Items: "  + CHR(9) + STR(loFolder.Items.Count)
 
    MSGSVC(lcMensagem)
 
ENDFOR

RELEASE ALL

RETURN

Trabajando con Contactos

El ítem Contactos (ContactItem en nuestro Modelo de Objetos) almacena diversas informaciones sobre un determinado Contacto. Para cada ítem, es posible almacenar 3 direcciones, 3 direcciones de mail, 19 números de Fax, teléfono, etc, y muchos otros datos. Aún así, si estos campos no fuesen suficientes, podemos crear otros definidos por el usuario (propiedad UserProperties). Los campos definidos por el usuarios son almacenados en cada ítem individualmente, o sea que un determinado registro puede tener un campo que los otros no posean. De esta manera, para recuperar algunos datos sobre nuestros Contactos tendríamos:

LOCAL loApplication, loNameSpace, loContacts, lnContador, loContact, lcMensagem

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

FOR lnContador = 1 TO loContacts.Items.Count

    loContact  = loContacts.Items(lnContador)
 
    lcMensagem = "Contacto: "  + CHR(9) + STR(lnContador)     + CHR(13) + CHR(10) +;
                 "Nombre: "    + CHR(9) + loContact.FirstName + CHR(13) + CHR(10) +;
                 "Apellido: "  + CHR(9) + loContact.LastName  + CHR(13) + CHR(10) +;
                 "Empresa: "   + CHR(9) + loContact.CompanyName

    MSGSVC(lcMensagem)

ENDFOR

RELEASE ALL

RETURN

Agregando y modificando Contactos

Para agregar un nuevo Contacto usamos el método Add y guardamos los cambios con el método Save. Haríamos:

LOCAL loApplication, loNameSpace, loContacts, loNewContact

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loNewContact  = loContacts.Items.Add()

loNewContact.FirstName   = "Filippo"
loNewContact.LastName    = "Cavalcanti"
loNewContact.FullName    = "Filippo Cavalcanti"
loNewContact.CompanyName = "Global Connection"

loNewContact.Save()   
 
RELEASE ALL

RETURN

Como podrá observar, mi hijo forma parte ahora de su archivo de Contactos. Para eliminarlo, use el método Delete.

Navegando, Ordenando y Buscando Datos

El Modelo de Objetos de Outlook provee métodos para facilitar la navegación dentro de un folder. Con el primer método, contamos el número de ítems dentro de un determinado folder y después, vamos pasando de a uno hasta el último:

LOCAL loApplication, loNameSpace, loContacts, loNewContact

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loItens       = loContacts.Items

FOR lnContador = 1 TO loItens.Count

    lcMensagem = "Nombre:   " + CHR(9) + loItens.Item(lnContador).FirstName + CHR(13) + CHR(10) +;
                 "Apellido: " + CHR(9) + loItens.Item(lnContador).LastName  + CHR(13) + CHR(10) +;
                 "Empresa:  " + CHR(9) + loItens.Item(lnContador).CompanyName
                 
    MSGSVC(lcMensagem)

ENDFOR

RELEASE ALL

RETURN

Podemos incluir el método Sort para ordenar los ítems por el campo especificado en el primer parámetro. El segundo parámetro indica si deseamos ordenar en orden creciente (.F.) o decreciente (.T.). Así que tendríamos:

LOCAL loApplication, loNameSpace, loContacts, loNewContact

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loItens       = loContacts.Items

loItens.Sort("[CompanyName]", .T.)

FOR lnContador = 1 TO loItens.Count

    lcMensagem = "Nombre:   " + CHR(9) + loItens.Item(lnContador).FirstName + CHR(13) + CHR(10) +;
                 "Apellido: " + CHR(9) + loItens.Item(lnContador).LastName  + CHR(13) + CHR(10) +;
                 "Empresa:  " + CHR(9) + loItens.Item(lnContador).CompanyName
                 
    MSGSVC(lcMensagem)

ENDFOR

RELEASE ALL

RETURN

Como segundo ejemplo, usamos los métodos GetFirst y GetLast, que devuelven el primer y último ítem de un Folder, respectivamente. Después de posicionados, usamos los métodos GetPrevious y GetNext para movernos arriba y abajo por la lista de un Folder.

Para localizarnos en un ítem determinado, usamos el método Find. El criterio de selección es pasado como único parámetro. Así para listar los contactos cuyo nombre empiecen con la letra "J", tendríamos:

LOCAL loApplication, loNameSpace, loContacts, loItens, loItem, lcMensagem

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loItens       = loContacts.Items

loItens.Sort("[FirstName]", .F.)

loItem        = loItens.Find("[FirstName]>='J'")

DO WHILE .T.

    IF LEFT(loItem.FirstName, 1) <> "J"
 
        EXIT
  
    ENDIF

    lcMensagem = "Nombre:   " + CHR(9) + loItem.FirstName + CHR(13) + CHR(10) +;
                 "Apellido: " + CHR(9) + loItem.LastName  + CHR(13) + CHR(10) +;
                 "Empresa:  " + CHR(9) + loItem.CompanyName
                 
    MSGSVC(lcMensagem)
 
    loItem     = loItens.FindNext()

ENDDO

RELEASE ALL

RETURN

Conclusión

Este artículo es el primero de una serie sobre OLE Automation y más cosas interesantes están por venir. Usando Outlook para almacenar información de Contactos es posible economizar programas para entrada de datos y eliminar redundancias. En el próximo artículo echaremos una mirada a otras dos áreas de Microsoft Outlook: Tareas y Calendario.


  • Descargue el código fuente AQUI (4 Kb).


José Augusto Cavalcanti

5 de septiembre de 2009

Abrir, Modificar, Guardar e Imprimir archivos .doc usando OpenOffice Writer

El programa utiliza un documento (.odt o .doc) que se usa como modelo en el que se insertan unas etiquetas, que luego son reemplazadas por los datos que provienen de una base de datos. Es la misma idea que usa Word en el Combinar correspondencia ...
local array laNoArgs[1]
local loSManager, loSDesktop, loStarDoc, loReflection, loPropertyValue, loOpenDoc, loCursor, loFandR

loSManager = createobject( "Com.Sun.Star.ServiceManager.1" )

loSDesktop = loSManager.createInstance( "com.sun.star.frame.Desktop" )
comarray( loSDesktop, 10 )

loReflection = loSManager.createInstance( "com.sun.star.reflection.CoreReflection" )
comarray( loReflection, 10 )

loPropertyValue = THISFORM.createStruct( @loReflection, "com.sun.star.beans.PropertyValue" )

laNoArgs[1] = loPropertyValue
laNoArgs[1].name = "ReadOnly"
laNoArgs[1].value = .F.

* crea un archivo nuevo ...
* url = "private:factory/swriter"

* Datos que vienen de la base de datos ...

lcTmp = "nombre del origen de datos"

lcNro_infor = PADL(&lcTmp..nro_infor, 8, '0')
lcDetalle   = &lcTmp..detalle
lcFecha     = DTOC(&lcTmp..fecha)

* Puede usar archivos en los 2 formatos: .odt y .doc
lcArchivoOrigen  = "C:/temp/modelo1.odt"
lcArchivoDestino = "C:/temp/eco" + lcNro_infor + " - " + ALLTRIM(lcDetalle) + ".odt"
*                   c:\temp\eco00112638 - 53565 diaz de rodriguez claudia.odt

lcArchivoOrigen  = "C:/temp/modelo1.doc"
lcArchivoDestino = "C:/temp/eco" + lcNro_infor + " - " + ALLTRIM(lcDetalle) + ".doc"
*                   c:\temp\eco00112638 - 53565 diaz de rodriguez claudia.doc

COPY FILE (lcArchivoOrigen) TO (lcArchivoDestino)

url = "file:///" + lcArchivoDestino

loOpenDoc = loSDesktop.LoadComponentFromUrl(url, "_blank", 0, @laNoargs)

* escribir texto en el documento ...
loCursor = loOpenDoc.text.CreateTextCursor()
loOpenDoc.text.InsertString(loCursor, "HELLO FROM VFP", .f. )

* Objeto para buscar las Marcas en el Documento
* si las marcas son encontradas, son remplazadas
* si alguna marca no existiera, no hay mayor problema, simplemente no se remplaza

loFandR = loOpenDoc.createReplaceDescriptor
loFandR.searchRegularExpression = .T.

loFandR.setSearchString("«nro_infor»")
loFandR.setReplaceString(lcNro_infor)
loOpenDoc.ReplaceAll(loFandR)

loFandR.setSearchString("«fecha»")
loFandR.setReplaceString(lcFecha)
loOpenDoc.ReplaceAll(loFandR)

loFandR.setSearchString("«detalle»")
loFandR.setReplaceString(lcDetalle)
loOpenDoc.ReplaceAll(loFandR)

* imprime el documento
* loOpenDoc.printer()

* graba el documento ...
* loOpenDoc.store()

* grabar con otro nombre ...
* Url = "file:///C:/temp/test3.odt"
* loStarDoc.storeAsURL(URL, @laNoargs)

RETURN

*--------- CreateStruct -----------*
PARAMETERS toReflection, tcTypeName

 local loPropertyValue, loTemp

 loPropertyValue = createobject( "relation" )

 toReflection.forName( tcTypeName ).createobject( @loPropertyValue )
     
return ( loPropertyValue )
El CreateStruct, yo lo uso como un metodo del formulario ...

Marcelo ARDUSSO
Rafaela, Santa Fe. Argentina

* http://wiki.services.openoffice.org/wiki/Documentation/BASIC_Guide/StarDesktop
* http://user.services.openoffice.org/es/forum/viewtopic.php?f=50&t=1306

* vb_oo2.zip <- ejemplo en Visual Basic descargado de La Web del Programador
* http://www.lawebdelprogramador.com

El siguiente es el archivo Modelo 1

Modelo 1
----------------------------------------------
Protocolo Nº «nro_infor»
Fecha «fecha»

Paciente: «detalle»

Estimado/a «detalle»

Esta es una prueba para generar informes en 
WRITER desde un programa de Visual Foxpro 9.0

Sin otro particular lo saludamos atte.

powered by: Visual Foxpro 9.0

12 de agosto de 2009

Corrección Ortográfica en VFP con el Diccionario de MSWord

El siguiente es un código que he adaptado, usando como base un mensaje de Luis María Guayán. Creo haber solucionado algunos problemas. Yo lo estoy usando con éxito. Espero que les sea de utilidad.
PUBLIC oForm
oForm = createobject("claseCorrector")
oForm.show()

DEFINE CLASS claseCorrector AS form
    Autocenter = .T.
    Top = 0
    Left = 0
    Height = 220
    Width = 377
    DoCreate = .T.
    Caption = "Corrector ortográfico de WORD"
    Name = "Form1"

ADD OBJECT edit1 AS editbox WITH ;
    Height = 170, ;
    Left = 10, ;
    TabIndex = 2, ;
    Top = 10, ;
    Width = 358, ;
    ControlSource = "", ;
    Name = "Edit1"

ADD OBJECT command1 AS commandbutton WITH ;
    Top = 185, ;
    Left = 285, ;
    Height = 27, ;
    Width = 84, ;
    Caption = "Ortografía", ;
    TabIndex = 1, ;
    Name = "Command1"

PROCEDURE Init
  LOCAL cString
   cString = "La gran mayoria de programadores Visual FoxPro se recisten a dejar " + ;
             "de programar en este lenguaje porque consideran que es una herramienta " + ;
             "muy poderosa, versátil y robusta que les permite crear aplicaciones " + ;
             "tan poderosas y hasta más estables que las creadas por otros lenguajes. " + ;
             "Incluso programadores que han tenido la oportunidad de desarrollar tanto " + ;
             "en Visual Basic.NET y Visual FoxPro 9.0 coinciden que FoxPro es largamente " + ;
             "superior en cuanto a practicidad y flexibilidad al momento de programar."
   thisform.edit1.Value = cString
ENDPROC

**********************************************************************************
* para incluír en los fuentes de cualquier programa, solo copiar el código       *
* del siguiente procedimiento en el evento "Click" del boton llame al corrector. *
* IMPORTANTE: cambiar el nombre del control que tiene el texto a corregir!       *
**********************************************************************************
PROCEDURE command1.Click
   LOCAL loWord, lnOldMousePointer, loControl
   loControl = Thisform.Edit1    && control que tiene el texto a corregir.
   lnOldMousePointer = loControl.Mousepointer
   loControl.Mousepointer = 11
      WAIT WINDOW NOWAIT "Iniciando la Corrección Ortográfica..."+CHR(13)+;
                         " Espere por favor" TIMEOUT 3
      IF VARTYPE( loWord ) <> 'O'
         loWord = CREATEOBJECT('word.application')
      ENDIF
      IF VARTYPE ( loWord ) = "O"
         loWord.documents.ADD()
         WITH loWord
            .documents(1).content = loControl.VALUE
            .windowstate = 2    && ventana minimizada
            .visible = .T.
            .documents(1).CheckSpelling()  &&Comenzando Corrección Ortográfica...
            .SELECTION.WholeStory
            IF .selection.text <> loControl.VALUE
               loControl.VALUE = .SELECTION.TEXT  
               WAIT WINDOW NOWAIT "Corrección Ortográfica Finalizada..."+CHR(13)+;
                                  " El texto fue reemplazado" TIMEOUT 3             
            ELSE
               WAIT WINDOW NOWAIT "Corrección Ortográfica Finalizada..."+CHR(13)+;
                                  " No se encontraron errores" TIMEOUT 3
            ENDIF
            .documents(1).CLOSE(.F.)
            .QUIT
         ENDWITH
         loWord = .NULL.
         RELEASE loWord
      ELSE
         MESSAGEBOX("Lo siento, no se puedo iniciar Word",48,_SCREEN.CAPTION)
         loControl.Mousepointer = lnOldMousePointer
         RETURN .F.
      ENDIF
   loControl.Mousepointer = lnOldMousePointer
ENDPROC

ENDDEFINE
Jorge Daniel Romero, Río Gallegos, Santa Cruz, Argentina

22 de marzo de 2009

Unifica dos archivos en formato MSWORD que estan separados en uno solo

Hace unos días un amigo me pidió que le ayudara con un rutina que ligara dos documentos separados en uno solo realizados en MSWORD. Aquí esta el código.

Todos los comandos utilizados en esta rutina están en la documentación que PortalFox tiene disponible para todos nosotros.

*--Verifica que existan los archivos antes de instanciar WORD
*--------------------------------------------------------------------------
*--Instancia y copia la primera hoja que contiene el texto del .RTF
*--------------------------------------------------------------------------
wFile=FULLPATH("HojaTexto.Rtf")
IF !FILE(wFile)
  =MESSAGEBOX("¡¡Archivo &wFile, no se pudo encontrar!!",16,Titulo)
  RETURN
ENDIF

*----------------------------------------------------------------------
*--Contiene la fotografia y pequeña reseña.
*----------------------------------------------------------------------
gFile=FULLPATH("hoja.Doc")
IF !FILE(gFile)
  =MESSAGEBOX("¡¡Archivo &gFile, no se pudo encontrar!!",16,Titulo)
  RETURN
ENDIF

*------------------------------------------------------------------------
*---ABRE WORD OCULTO PARA COPIAR LOS DATOS Y SE SALE
*------------------------------------------------------------------------
oWord=CREATEOBJECT("Word.Application")
WAIT WIND "Abriendo sesión de MS Word" NOWAIT
WITH oWord
  .Documents.ADD(wFile)  &&Abre el documento .RTF
  .ActiveDocument.SELECT &&Activa la hoja
  cText=.SELECTION.TEXT  &&Selecciona todo el texto
  .SELECTION.COPY        &&Copia todo el texto del documento seleccionado
  .VISIBLE=.F.           &&Abre la primera INSTANCIA de WORD OCULTO del documento .RTF
  .ActiveDocument.CLOSE  &&Cierra el documento .RTF ACTIVO

  .Documents.ADD(gFile)  &&Abre el documento .DOC que contiene las fotos
  .CAPTION="ProtalFox.com......" &&Coloca un titulo al documento

  *--Bajar las filas que desea en el documento abierto
  FOR i=1 TO 100         &&Baja 100 lineas hasta el final del archivo
    oWord.SELECTION.MoveDown
  ENDFOR
  .SELECTION.Paste       &&Pega los datos al final del documento .DOC
  *.Selection.HomeKey     &&Se supone que coloca el cursor en la primera linea
  .VISIBLE=.T.
ENDWITH
WAIT CLEAR
RETURN
*------------------------------------------------------------------------
Tonny Molina

25 de septiembre de 2007

Exportar a OpenOffice.org Calc

Rutina de Hector Urrutia para exportar un cursor a OpenOffice Calc.
*-------------------------------------------------------------*
*!*- FUNCTION ExporToCalc([cCursor], [cDestino], [cFileSave])
*!*- cCursor:  Alias del cursor que se va a exportar.
*!*- cDestino:  Nombre de la carpeta donde se va a grabar.
*!*- cFileName:  Nombre del archivo con el que se va a grabar.
*-------------------------------------------------------------*
FUNCTION ExporToCalc(cCursor, cDestino, cFileSave)
  LOCAL oManager, oDesktop, oDoc, oSheet, oCell, oRow, FileURL
  LOCAL ARRAY laPropertyValue[1]

  cWarning = "Exportar a OpenOffice.org Calc"

  IF EMPTY(cCursor)
    cCursor = ALIAS()
  ENDIF

  IF TYPE('cCursor') # 'C' OR !USED(cCursor)
    MESSAGEBOX("Parametros Invalidos",16,cWarning)
    RETURN .F.
  ENDIF

  lColNum = AFIELDS(lColName,cCursor)

  EXPORT TO (cDestino + cFileSave + [.ods]) TYPE XL5

  oManager = CREATEOBJECT("com.sun.star.ServiceManager.1")

  IF VARTYPE(oManager, .T.) # "O"
    MESSAGEBOX("OpenOffice.org Calc no esta instalado en su computador.",64,cWarning)
    RETURN .F.
  ENDIF

  oDesktop = oManager.createInstance("com.sun.star.frame.Desktop")

  COMARRAY(oDesktop, 10)

  oReflection = oManager.createInstance("com.sun.star.reflection.CoreReflection")

  COMARRAY(oReflection, 10)

  laPropertyValue[1] = createStruct(@oReflection, "com.sun.star.beans.PropertyValue")
  laPropertyValue[1].NAME = "ReadOnly"
  laPropertyValue[1].VALUE= .F.

  FileURL = ConvertToURL(cDestino + cFileSave + [.ods])

  oDoc = oDesktop.loadComponentFromURL(FileURL , "_blank", 0, @laPropertyValue)

  oSheet = oDoc.getSheets.getByIndex(0)

  FOR i = 1 TO lColNum
    oColumn = oSheet.getColumns.getByIndex(i)
    oColumn.setPropertyValue("OptimalWidth", .T.)

    oCell = oSheet.getCellByPosition( i-1, 0 )
    oDoc.CurrentController.SELECT(oCell)

    WITH oDoc.CurrentSelection
      .CellBackColor = RGB(200,200,200)
      .Cell
      .CharColor = RGB(255,0,0)
      .CharHeight = 10
      .CharPosture = 0
      .CharShadowed = .F.
      .FormulaLocal = lColName[i,1]
      .HoriJustify = 2
      .ParaAdjust = 3
      .ParaLastLineAdjust = 3
    ENDWITH
  ENDFOR

  oCell = oSheet.getCellByPosition( 0, 0 )
  oDoc.CurrentController.SELECT(oCell)

  laPropertyValue[1] = createStruct(@oReflection, "com.sun.star.beans.PropertyValue")
  laPropertyValue[1].NAME = "Overwrite"
  laPropertyValue[1].VALUE = .T.

  oDoc.STORE()
ENDFUNC

FUNCTION createStruct(toReflection, tcTypeName)
  LOCAL loPropertyValue, loTemp
  loPropertyValue = CREATEOBJECT("relation")
  toReflection.forName(tcTypeName).CREATEOBJECT(@loPropertyValue)
  RETURN (loPropertyValue)
ENDFUNC

FUNCTION ConvertToURL(tcFile AS STRING)
  IF(TYPE( "tcFile" ) == "C") AND (!EMPTY( tcFile ))
    tcFile = [file:///] + CHRTRAN(tcFile, "\", "/" )
  ELSE
    tcFile = [file:///C:/] + ALIAS() + [.ods]
  ENDIF
  RETURN tcFile
ENDFUNC

AUTOR: Hector Urrutia

Saludos desde EL Salvador