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

XL8Table() : Importe une feuille d'un classeur Excel 97-2000 dans une table VFP   



L'auteur

FoxInCloud (Th. Nivelet)
France France
Membre Simple
# 0000000014
enregistré le 13/10/2004

http://www.foxincloud.com/
Nivelet Thierry
75016 Paris
de la société Abaque
Fiche personnelle


Note des membres
pas de note

Contributions > 01 - PRG : Programmation > Import - Export

XL8Table() : Importe une feuille d'un classeur Excel 97-2000 dans une table VFP
# 0000000022
ajouté le 21/10/2004 10:14:01 et modifié le 03/10/2009
consulté 11038 fois
Niveau débutant

Description

* Les noms des champs sont lus dans la première ligne de la feuille
* Les colonnes sans nom de champ sont ignorées
* Les colonnes sont importées en caractères
* Les colonnes masquées ne sont pas importées
* Les colonnes servant à une concaténation sont tronquées

Retourne l'adresse de la table créée ou erreur en clair.

Livré avec 2 utilitaires :
- XL8Table_ModiStru : Renomme les champs selon la première ligne de la feuille XL
- lFileFresher : dit si un fichier est plus récent qu'un autre

Nécessite diverses fonctions postées ici même.

Code source :
******************************************************************************************
    PROCEDURE XL8Table  && Importe une feuille d'un Classeur Excel 97 dans une table
        * Les noms des champs sont lus dans la première ligne de la feuille
        * Les colonnes sont importées en caractères
        * Les colonnes masquées ne sont pas importées
        * Les colonnes servant à une concaténation sont tronquées
    LPARAMETERS ;
        tcXLWBAddr, ; && Adresse du MASQUE de classeur Excel contenant la feuille à importer
        tcSheet, ; && [feuille n°1] Nom de la feuille à importer
        tlNonVerifDernVers,;    && [.F.] Ne pas prendre la dernière version du classeur Excel
        ;                           && si @, indique en retour si la table a été rafraîchie
        tlImportForce && [.F.] Importer même si le classeur est plus ancien que la table

    LOCAL lcResult  && Adresse de la table créée ou message d'erreur
    m.lcResult = Space(0)

    IF Vartype(m.tcXLWBAddr) = 'C'

        * Régler les valeurs par défaut des paramètres
        LOCAL lcSheet, llNonVerifDernVers
        m.llNonVerifDernVers = Iif(Vartype(m.tlNonVerifDernVers) = 'L', m.tlNonVerifDernVers, .F.)
        m.lcSheet = Iif (Vartype(m.tcSheet)='C'Upper(m.tcSheet), Space(0))
        m.llImportForce = Iif(Vartype(m.tlImportForce)=='L', m.tlImportForce, .F.)

        * Si un classeur existe selon le masque spécifié
        LOCAL lcXLWBAddr
        m.lcXLWBAddr = IIF (m.llNonVerifDernVers, m.tcXLWBAddr, cFileFreshest(m.tcXLWBAddr))
        IF File(m.lcXLWBAddr)


            * Déterminer l'adresse de la table destination
            LOCAL lcXLWBPath, lcDBFStem, lcDBFAddr
            m.lcXLWBPath = Addbs(JustPath(m.lcXLWBAddr))
            m.lcDBFStem = Iif (Empty(m.lcSheet), JustStem(m.tcXLWBAddr), m.lcSheet)
            m.lcDBFAddr = m.lcXLWBPath +    ForceExt(m.lcDBFStem, EXT_DBF)

            * Si import systématique ou classeur plus récent que la table
            LOCAL llImport
            m.llImport = m.llImportForce .ORNvl(lFileFresher (m.lcDBFAddr, m.lcXLWBAddr), .T.)
            m.lcResult = m.lcDBFAddr
            IF m.llImport

                * Si le classeur n'est pas couramment ouvert
                LOCAL lnHandle
                m.lnHandle = Fopen(m.lcXLWBAddr, 1)
                m.llImport = m.lnHandle > 0 ;
                 OR (Set('ASSERT') == 'ON' AND 6 = ;
                                 MessageBox("L'importation de données depuis le classeur " + m.lcXLWBAddr + " est impossible car il est ouvert par Excel" + CRLF + ;
                                    "Pour continuer l'importation, veuillez fermer le classeur et cliquer sur 'oui'" + CRLF + ;
                                    "Pour abandonner l'importation, cliquez sur 'non'" + CRLF + ;
                                    "Continuer ?", 4+16))
                Fclose(m.lnHandle)
                IF m.llImport

                    * Si la feuille peut être importée
                    LOCAL lcDefault, lnSelect, llSheet
                    m.lcDefault = Set('Default') + CurDir ()    && Unité de disque + Dossier
                    m.lnSelect = Select(0)
                    m.llSheet = .T.
                    SET DEFAULT TO (m.lcXLWBPath) && Obligé de changer le default car l'import doit placer la nouvelle table dedans
                    SELECT 0    && Première zone libre où se placera la table créée
                    IF Empty(m.lcSheet)
                        IMPORT FROM (m.lcXLWBAddr) TYPE XL8
                    ELSE
                        LOCAL lcError
                        m.lcError = On('Error')
                        ON ERROR m.llSheet = .F.
                        IMPORT FROM (m.lcXLWBAddr) TYPE XL8 Sheet (m.lcSheet)
                        ON ERROR &lcError
                    ENDIF
                    SET DEFAULT TO (m.lcDefault)
                    IF m.llSheet

                        LOCAL lcAlias
                        m.lcAlias = Alias()

                        * Renommer les champs par le contenu de la premiere ligne du tableau
                        IF XL8Table_ModiStru (m.lcAlias)

                            * Renommer la table selon le nom de la feuille ou du classeur spécifiés
                            LOCAL lcDBFImportAddr
                            m.lcDBFImportAddr = cTableAddress(m.lcAlias)
                            USE IN (m.lcAlias)
                            IF Upper (m.lcDBFImportAddr) # Upper (m.lcDBFAddr)
                                * Effacer la précédente le cas échéant
                                IF File (m.lcDBFAddr)
                                    DELETE FILE (m.lcDBFAddr)
                                ENDIF
                                RENAME (m.lcDBFImportAddr) to (m.lcDBFAddr)
                            ENDIF
                        ELSE
                            m.lcResult = "XL8Table() : Impossible de nommer les champs selon le contenu de la première ligne de la feuille " + m.lcSheet + " du classeur " + m.lcXLWBAddr
                        ENDIF
                    ELSE
                        m.lcResult = "XL8Table() : Importation impossible car la feuille " + m.lcSheet + " n'existe pas dans le classeur " + m.lcXLWBAddr
                    ENDIF
                    SELECT (m.lnSelect)
                ELSE
                    m.lcResult = "XL8Table() : Importation impossible car le classeur " + m.lcXLWBAddr + " était ouvert."
                ENDIF
            ENDIF
            m.tlNonVerifDernVers = m.llImport && indique si la feuille a été importée
        ELSE
            m.lcResult = "XL8Table() : Importation impossible car aucun classeur n'existe selon le masque spécifié :" + Alltrim(tcXLWBAddr)
        ENDIF
    ELSE
        m.lcResult = "XL8Table() : Veuillez spécifier un masque de classeur XL en première paramètre"
    ENDIF
    ASSERT File(m.lcResult) MESSAGE m.lcResult

    RETURN m.lcResult

******************************************************************************************
    Procedure XL8Table_ModiStru && Renomme les champs selon la première ligne de la feuille XL
    LPARAMETERS tcAlias && Alias de la table importée d'Excel

    LOCAL llResult

    LOCAL tcAlias
    IF Used(m.tcAlias) ;
     AND IsExclusive(m.tcAlias)

        LOCAL lnSelect
        m.lnSelect = Select(0)
        SELECT (m.tcAlias)

        * Lire la structure de la table
        LOCAL lnChps
        LOCAL ARRAY laCh[1]laChNouv[1]
        m.lnChps = AFields(m.laCh)

        * Lire le premier enregistrement contenant les noms de champs
        GO 1
        SCATTER TO laChNouv

        LOCAL ;
            lnChp, ;    && ne pas utiliser 'i' qui est un nom de colonne XL
            lcChNouv, ;
            lcChAnc, ;
            lnChpId, ;
            lcChpId

        FOR m.lnChp = 1 to m.lnChps

            m.lcChAnc = laCh[m.lnChp, 1]
            m.lcChNouv = laChNouv[m.lnChp]
            m.lcChNouv = IIF (Vartype(m.lcChNouv) == 'C'Upper(Alltrim(m.lcChNouv)), space(0))

            * Si le nouveau nom est vide, supprimer la colonne
            If Empty(m.lcChNouv)
                Alter table (m.tcAlias) drop column (m.lcChAnc)

            * Sinon (nouveau nom non vide)
            ELSE

                * Si le champ est numérique, le passer en caractères et supprimer les espaces en tête
                IF m.laCh[m.lnChp, 2] == 'N'
                    ALTER TABLE (m.tcAlias) ALTER COLUMN (m.lcChAnc) C (m.laCh[m.lnChp,3] + 1 + m.laCh[m.lnChp,4])
                    REPLACE ALL (m.lcChAnc) with Ltrim(Evaluate(m.lcChAnc))
                    m.laCh[m.lnChp, 2] = 'C'
                ENDIF

                * Normaliser le nom de champ
                m.lcChNouv = cVFPName(m.lcChNouv, 10)

                * Si le nom du champ existe déjà, lui donner un suffixe numérique
                m.lnChpId = 0
                DO WHILE Ascan(m.laCh, m.lcChNouv, 1, -1, 1, 2+4) > 0
                    m.lnChpId = m.lnChpId + 1
                    m.lcChpId = Alltrim(Str(m.lnChpId))
                    m.lcChNouv = substr(m.lcChNouv, 1, 10-Len(m.lcChpId)) + m.lcChpId
                ENDDO

                * Renommer le champ
                ALTER TABLE (m.tcAlias) RENAME COLUMN (m.lcChAnc) to (m.lcChNouv)

            ENDIF
            laCh[m.lnChp, 1] = m.lcChNouv

        ENDFOR

        * Supprimer le premier enregistrement contenant les noms de champs
        GO 1
        DELETE
        PACK
        DELETE FILE (ForceExt(cTableAddress(m.tcAlias), 'BAK'))

        SELECT (m.lnSelect)
        m.llResult = .T.
    ENDIF

    RETURN m.llResult

******************************************************************************************
    FUNCTION lFileFresher   && Un fichier est plus récent qu'un autre
    LPARAMETERS ;
        tcFile1Addr, ; && Adresse du fichier de base
        tcFile2Addr     && Adresse du fichier à comparer
    LOCAL llResult
    m.llResult = NULL

    * Si les deux fichiers existent
    IF Vartype(m.tcFile1Addr)=='C' ;
     AND File (m.tcFile1Addr) ;
     AND Vartype(m.tcFile2Addr)=='C' ;
     AND File (m.tcFile2Addr)

        m.llResult = Fdate (m.tcFile2Addr, 1) > Fdate (m.tcFile1Addr, 1)
    ENDIF

    RETURN m.llResult


Commentaires
le 03/10/2009, api1492 a écrit :
Bonsoir,
sous VFP6
Procedure XL8Table_ModiStru
......
à la ligne d'instruction :
DO WHILE Ascan(m.laCh, m.lcChNouv, 1, -1, 1, 2+4) > 0
j'ai un message d'erreur "Trop arguments"
Vous voyez pourqoi?
Merci d'avance
Daniel

le 03/10/2009, FoxInCloud (Th. Nivelet) a écrit :
essayez
VFP6 > F1 > Index > aScan()


Publicité

Les pubs en cours :


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