ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Exemples de l'automation d'Excel   



L'auteur

Mike Gagnon
Canada Canada
Membre Simple
# 0000000025
enregistré le 14/10/2004

Gagnon Mike
Pte Claire Quebec - Canada
de la société MCRG Software
Fiche personnelle


Note des membres
18,5/20
2 votes


Contributions > 09 - Automation > Excel

Exemples de l'automation d'Excel
# 0000000073
ajouté le 18/11/2004 20:12:14 et modifié le 18/11/2004
consulté 10143 fois
Niveau débutant

Version(s) Foxpro :
VFP 7.0

Description

Voici quelque exemples d'automation d'excel.

Code source :
&& Créer un instance d'Excel

LOCAL loExcel
loExcel = createobject('excel.application')
loExcel.visible = .t.

&& Ajouter un workbook dans Excel

LOCAL loExcel,loWorkBook
loExcel = createobject('excel.application')
loWorkBook = loExcel.Workbooks.add()
loExcel.visible = .t.

&& Ajouter un Workbook de seulement une feuille.

tmpsheet = CREATEOBJECT('excel.application')
oExcel = tmpsheet.APPLICATION
oExcel.SheetsInNewWorkbook = 1
oExcel.Workbooks.CLOSE
oExcel.Workbooks.ADD
xlBook = oExcel.ActiveWorkbook.FULLNAME
xlSheet = oExcel.activesheet
xlSheet.NAME = "Feuille numéro 1"
oExcel.VISIBLE = .T.

&& Exemple simple comment utilser les fonctions Excel avec VFP (SUM)

CREATE CURSOR curCompany (Company C(20), Qtr1 N(10,2), qtr2 N(10,2), qtr3 N(10,2), qtr4 N(10,2))
FOR lni = 1 TO 10
    APPEND BLANK
    REPLACE curCompany.company WITH SYS(2015)
    REPLACE curCompany.qtr1 WITH 1 + 1000 * RAND( )
    REPLACE curCompany.qtr2 WITH 1 + 1000 * RAND( )
    REPLACE curCompany.qtr3 WITH 1 + 1000 * RAND( )
    REPLACE curCompany.qtr4 WITH 1 + 1000 * RAND( )
ENDFOR
local oExcel, oSheet
oExcel = CreateObject([Excel.Application])
oExcel.Visible = .T.
oExcel.Workbooks.Add()
oSheet = oExcel.ActiveSheet
lnRow = 0
SELECT curCompany
GO TOP
DO WHILE NOT EOF()
    lnRow = lnRow + 1
    IF lnRow = 1
        oSheet.Cells(lnRow,1).Value = [vfp!]
        lnRow = 3
        lnCol = 3
        oSheet.Range([C3]).Select
        oSheet.Cells(lnRow,lnCol).Value = [Qtr 1]
        oSheet.Cells(lnRow,lnCol).Font.Bold = .T.
        oSheet.Cells(lnRow,lnCol).HorizontalAlignment = 3
        lnCol = lnCol + 1
        oSheet.Range([D3]).Select
        oSheet.Cells(lnRow,lnCol).Value = [Qtr 2]
        oSheet.Cells(lnRow,lnCol).Font.Bold = .T.
        oSheet.Cells(lnRow,lnCol).HorizontalAlignment = 3
        lnCol = lnCol + 1
        oSheet.Range([E3]).Select
        oSheet.Cells(lnRow,lnCol).Value = [Qtr 3]
        oSheet.Cells(lnRow,lnCol).Font.Bold = .T.
        oSheet.Cells(lnRow,lnCol).HorizontalAlignment = 3
        lnCol = lnCol + 1
        oSheet.Range([F3]).Select
        oSheet.Cells(lnRow,lnCol).Value = [Qtr 4]
        oSheet.Cells(lnRow,lnCol).Font.Bold = .T.
        oSheet.Cells(lnRow,lnCol).HorizontalAlignment = 3
       lnRow = 4
       lnBeginRange = lnRow
    ENDIF
    oSheet.Cells(lnRow,1).Value = curCompany.Company
    oSheet.Cells(lnRow,3).Value = curCompany.qtr1
    oSheet.Cells(lnRow,4).Value = curCompany.qtr2
    oSheet.Cells(lnRow,5).Value = curCompany.qtr3
    oSheet.Cells(lnRow,6).Value = curCompany.qtr4
    SKIP
ENDDO
FOR lni = 1 TO 4
lcFormula = [=SUM(] + CHR(64 + lni) + ALLTRIM(STR(m.lnBeginRange)) + [:] +;
                CHR(64 + 3 + lni) + ALLTRIM(STR(m.lnRow)) + [)]
oSheet.Cells(lnRow+1,2+lni).Formula = [&lcFormula]
ENDFOR

&& Créer une charte avec l'automation d'Excel

Public oExcel, oBook, oSheet
#Define xlColumnClustered  51
#Define xlColumns 2
#Define xlAutoFill 4
Close All
Open Database (Home(2) + "\TASTRADE\DATA\Tastrade")
Use Customer In 0
Select 0
Use "Sales Summary" Alias Sommaire
Select Substr(Sommaire.exp_1,1,4) As entetes From Sommaire Group By entetes Into Cursor entetes
oExcel = Createobject("Excel.Application")
oExcel.Visible = .T.
oBook  = oExcel.Workbooks.Add()
oSheet = oBook.activesheet
transpose('entetes'&& Faire un pivotage de la table pour obtenir les entetes
createExcelChart('tbl_transformed','Sommaires'&& Commencer à créer la charte - Parametres : Table et titre

Function createExcelChart(lcAlias,lcSheetname)
  With oSheet
    .Range("A2").Value = "January"
    .Range("A2:A13").DataSeries(xlColumns, xlAutoFill, 1, 1)
  Endwith
  With oSheet
    .Name = lcSheetname  && Inscrire le nom de la feuille à partir du parametre
    nfieldno=Afields(arrfielda,lcAlias)
    Select &lcAlias
    nrow=1
    Scan
      For N=2 To nfieldno
        cfield=lcAlias+'.'+arrfielda(N,1)
        .Cells(nrow,N).Value=(&cfield)
      Endfor
      .Cells(nrow,1).Select
      nrow=nrow+1
    Endscan
    .Columns("A:A").EntireColumn.AutoFit
    CurrentColumn = "A"
    CurrentYear   = "X"
    Select Sommaire
    Scan
      If CurrentYear <> Left(Sommaire.exp_1, 4)
        CurrentYear = Left(Sommaire.exp_1, 4)
        CurrentColumn = Chr(Asc(CurrentColumn) + 1)
        .Range(CurrentColumn + "1").Value = CurrentYear
      Endif
      CurrentRow = Alltrim(Str(Val(Right(Sommaire.exp_1, 2)) + 1))
      .Range(CurrentColumn + CurrentRow).Value = Sommaire.sum_unit_price
    Endscan
    For i = 1 To Asc(CurrentColumn) - 63
      .Columns[i].ColumnWidth = 12
    Next i
  ENDWITH

  With oBook
    .Charts.Add
    .ActiveChart.ChartType = xlColumnClustered
    .ActiveChart.SetSourceData(oSheet.Range("A1:F13"))
    .ActiveChart.HasTitle = .F.
    .ActiveChart.Location(3,"Sommaires")
  Endwith
  With oSheet
    .Shapes("Chart 1").IncrementLeft( -100.5)
    .Shapes("Chart 1").IncrementTop( 76.5)
    .Shapes("Chart 1").ScaleWidth( 1.86,.F.,1)

  Endwith


Endfunc
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Procedure transpose(lcMyTable)
  lctalk=Set("Talk")

  Set Talk Off

  If Used(lcMyTable)=.F.
    Use (lcMyTable) In 0
  Endif

  Select (lcMyTable)

  lnMaxWidth=1
  lcBuildTable=""

  For lnFieldCounter = 1 To Afields(laFields)
    lnMaxWidth=Max(lnMaxWidth,laFields(lnFieldCounter,3))
  Endfor

  For lnRowCounter = 1 To Min(Reccount(),254)
    lcBuildTable=lcBuildTable+Iif(lnRowCounter=1,"",",")+" COL"+Transform(lnRowCounter)+" C("+Transform(lnMaxWidth)+")"
  Endfor

  Create Table tbl_transformed Free (Headers c(10),&lcBuildTable)
  For lnRecords= 1 To Max(1,lnFieldCounter-1)
    Append Blank
  Endfor

  Select (lcMyTable)
  lcColsToTrans=Afields(laFields)
  Scan For Recno()<=254
    lnTransCol=Recno()
    For lnCounter = 1 To lcColsToTrans
      lcVar="Var"+Transform(lnCounter)
      &lcVar=Evaluate(laFields(lnCounter,1))
    Endfor

    Select tbl_transformed

    For lnCounter2 = 1 To lcColsToTrans
      Go lnCounter2
      lcVar="Var"+Transform(lnCounter2)
      Replace (Field(lnTransCol+1)) With Transform(&lcVar)
    Endfor
  Endscan
  Select tbl_transformed
  For lnCounter = 1 To lcColsToTrans
    Go lnCounter
    Replace (Field(1)) With (laFields(lnCounter,1))
  Endfor
  Go Top
  Set Talk &lctalk
Endproc


&& Formatter un feuille Excel avec VFP

#Define xlCenter  -4108
#Define xlBottom  -4107
#Define xlContext  -5002

Local oExcel,oSheet
Private oBook  && Besoin d'être Private pour pouvoir l'utiliser dans la fonction sinon on perd le scope.
Close Data
Open Database HOME(2) + "\TASTRADE\DATA\Tastrade"  && Ouvrir le base de données
Use CUSTOMER Shared Again In 0
*****Créer un curseur des records requis***********
Select company_name As Compagnie,contact_name As Contact,Address As Adresse,;
  City As Ville,Region,Postal_code As Postale,Country As Pays From CUSTOMER Where Country = "France" Into Cursor result1
***************************************************
oExcel = Createobject("Excel.Application")  && Créer un instance d'Excel
oBook  = oExcel.Workbooks.Add()  && Ajouter un WorkBook
oSheet = oBook.ActiveSheet && Selectionner la feuille active
createExcel("Mes Clients","result1"&& Faire appel à la fonction qui mettre les records sur la feuille active
oExcel.Visible =.T.  && Montrer Excel


Function createExcel(lcSheetname,lcAlias)
  With oBook
    .Sheets(1).Select  && S'assurer que la première feuille est active
    With .ActiveSheet
      .Name = lcSheetname  && Inscrire le nom de la feuille à partir du parametre
      nfieldno=Afields(arrfielda,lcAlias)  && Assez générique que on peut utiliser n'importe quel curseur.
      For N=1 To nfieldno  && Ajouter les titres des champs pour chaque colonnes
        .Cells(1,N).Value=arrfielda(N,1)
      Endfor
      nrow=2
      Select &lcAlias  && Sélectionner notre curseur
      Scan
        For N=1 To nfieldno
          cfield=lcAlias+'.'+arrfielda(N,1)
          .Cells(nrow,N).Value=(&cfield)
        Endfor
        .Cells(nrow,1).Select
        nrow=nrow+1
      Endscan
      nValue = 65
      For N=1 To nfieldno
        cColumn = Chr(nValue)
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).EntireColumn.AutoFit
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).Select
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).HorizontalAlignment = xlCenter
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).VerticalAlignment = xlBottom
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).WrapText = .F.
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).Orientation = 0
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).AddIndent = .F.
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).IndentLevel = 0
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).ShrinkToFit = .F.
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).ReadingOrder = xlContext
        .Columns(Transform(cColumn)+':'+Transform(cColumn)).MergeCells = .F.
        nValue = nValue + 1
      Endfor
      .Cells.Select
    Endwith
  Endwith
Endfunc

Commentaires
le 24/02/2008, DoumDoum58 a écrit :
Ces exemples m'ont été très utiles pour mon dernier développement.
Merci

le 24/02/2008, Mike Gagnon a écrit :
Pas de quoi.
le 03/07/2009, TIEKEN a écrit :
slt merci pour ces exemples qui m'ont beaucoup aide. j'aimerais savoir comment ouvrir un document PDF enregistrer dans un champ général d'une table dans adobe par exemple?
merci d'avance.


Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2019.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3