Xl8table() : importe une feuille d'un classeur excel 97 dans une table visual foxpro

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 100 fois - Téléchargée 34 fois

Contenu du snippet

  • 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
  • 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
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)
  • Remove accents
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)
  • Trim right is required
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
  • Translate
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.

A voir également

Ajouter un commentaire

Commentaires

Roland38
Messages postés
32
Date d'inscription
lundi 4 octobre 2004
Statut
Membre
Dernière intervention
21 avril 2008
-
Pourquoi Excel 97 ?
Tout évolu, il serait très intéressant de pouvoir accéder à des pages de n'importe quel Excel.
Quant penssez-vous ?

Cordialement
AbaqueInside
Messages postés
16
Date d'inscription
mardi 5 octobre 2004
Statut
Membre
Dernière intervention
14 novembre 2009
1 -
Jusqu'à la version courante de VFP (8), seul le format XL8 (97) est supporté.

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.
POINTMICRO
Messages postés
1
Date d'inscription
jeudi 18 novembre 2004
Statut
Membre
Dernière intervention
27 juillet 2006
-
Svp, me donner un exemple concret car je suis nouveau avec fox

Merci

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.