XL8TABLE() : IMPORTE UNE FEUILLE D'UN CLASSEUR EXCEL 97 DANS UNE TABLE VISUAL FOXPRO

******************************************************************************************
	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'