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
Pointe Cla H9R 3K8
de la société Carver Technologies Inc.
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é 15055 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.
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3