L'auteur
FoxInCloud (Th. Nivelet)
 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é 11419 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 .OR. Nvl(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 |
|---|
|
|
Retour à la liste
le 03/10/2009,
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