- 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
Retourne l'adresse de la table créée ou erreur en clair
Source / Exemple :
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
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
FUNCTION cVFPName && Nom valide pour VFP, avec longueur limitée si nécessaire
LPARAMETERS ;
tcVFPName, ; && Nom VFP à valider
tnLength && [len(tcVFPName)] Longueur maximale du nom (par ex. 10 pour un nom de champ de table libre)
LOCAL lcResult
m.lcResult = space(0)
IF Vartype(m.tcVFPName) = 'C' ;
AND ! Empty(m.tcVFPName)
LOCAL lcVFPName
m.lcVFPName = cEuroANSI(alltrim (m.tcVFPName))
- Start with underscore if first is a digit
m.lcVFPName = Iif(IsDigit(m.lcVFPName), UNDERSCORE, Space(0)) + m.lcVFPName
- Turn characters neither digit or letter to underscore
LOCAL lnCar, lcCar
FOR m.lnCar = 1 TO Len(m.lcVFPName)
m.lcCar = Substrc(m.lcVFPName, m.lnCar, 1)
m.lcCar = Iif(isDigit(m.lcCar) or IsAlpha(m.lcCar), ;
m.lcCar, UNDERSCORE)
m.lcResult = m.lcResult + Upper(m.lcCar)
ENDFOR
- Remove duplicate underscores
m.lcResult = cRepCharDel (m.lcResult, UNDERSCORE)
m.lcResult = Iif(m.lcResult==UNDERSCORE, Space(0), m.lcResult)
IF Vartype(m.tnLength) = 'N' ;
AND m.tnLength > 0
m.lcResult = Leftc(m.lcResult, m.tnLength)
ENDIF
ENDIF
RETURN m.lcResult
- -----------------------------------------------------------------
PROCEDURE cVFPName_Test
? Sys(16)
? cVFPName ('%cartable/poiré') == '_CARTABLE_POIRE'
? cVFPName ('2cartable.poiré') == '_2CARTABLE_POIRE'
? cVFPName ('2cartable.:poiré') == '_2CARTABLE_POIRE'
? cVFPName ('2cartable.:poiré', 9) == Leftc('_2CARTABLE_POIRE', 9)
? cVFPName ('150') == '_150'
- -------------------------------------------------------------
FUNCTION cEuroANSI && Chaine de caractères désaccentuée
LPARAMETERS tcEuropean && Chaine de caractères accentuée
local lcResult && Chaine de caractères désaccentuée
m.lcResult = space(0)
IF Vartype(m.tcEuropean) = 'C' ;
AND !Empty(m.tcEuropean) ;
AND !IsNull(m.tcEuropean)
- Restore translation strings
IF NOT Vartype(m.European) == 'C' ;
OR NOT Vartype(m.EuroANSI ) == 'C'
PUBLIC European, EuroANSI
RESTORE FROM (Home()+'european.mem') ADDITIVE
ENDIF
m.lcResult = Sys(15, m.EuroANSI, m.tcEuropean)
- m.lcResult = Chrtran(m.tcEuropean, m.European, m.EuroANSI)
ENDIF
RETURN m.lcResult
- -----------------------------------------------------------------
PROCEDURE cEuroANSI_Test
? Sys(16)
RELEASE European, EuroANSI
? cEuroANSI (.T.) = space(0)
? cEuroANSI (space(0)) = space(0)
? cEuroANSI (null) = space(0)
? cEuroANSI ('hébété') = 'hebete'
? cEuroANSI ('àäâéèêëioòùû') = 'aaaeeeeioouu'
? cEuroANSI ('ÀÄÂÉÈÊËIOÒÙÛ') = 'AAAEEEEIOOUU'
Conclusion :
J'ai pu oublier des fonctions appelées ... Si c'est le cas merci de me les signaler.
27 juil. 2006 à 20:17
Merci
20 oct. 2004 à 10:03
Gageons que VFP9 ira plus loin !!
il suffit d'enregistrer sous... pour utiliser XL8Table().
Include XL8 to import data from Microsoft Excel 97. Columns from the worksheet become fields in the table and the worksheet rows become records in the table. Worksheet files created in Microsoft Excel have an .xls extension.
20 oct. 2004 à 09:08
Tout évolu, il serait très intéressant de pouvoir accéder à des pages de n'importe quel Excel.
Quant penssez-vous ?
Cordialement
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.