1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
|
' Déclaration des variables
Dim Nom1, Path1, Nom2, Path2, PathGen, Lib As String
Dim NomVariante, NomOuverture, NomAUtiliser As String
' Nom variante choisi par l'utilisateur
NomVariante = InputBox$("Choisissez le nom de la variante", "Choix du nom de la variante", "_LT_")
' Déclaration des variables "fixes" pour les dossiers
PathGen = InputBox$("Choisissez le dossier où sont contenus les données", "Choix du dossier", "D:\Données\")
'PathGen = "D:\Données\" 'Texte fixe
Lib = "maLib"
' ******************************************************
' * 1er fichier supposé ouvert, actif (au premier plan)*
' ******************************************************
Nom1 = ActiveWorkbook.Name ' recupere le nom du fichier 1
Nom1 = Left(Nom1, Len(Nom1) - 4) ' enleve l'extension
Path1 = PathGen & Lib & "." & Nom1 & "\"
' Sélection de la feuille à exporter en fichier texte puis exportation
Sheets("maLib.nom1").Select
NomAUtiliser = Path1 & Nom1 & NomVariante & ".txt"
ActiveWorkbook.SaveAs Filename:=NomAUtiliser, FileFormat:=xlText, CreateBackup:=False
' *****************************************
' ******* Ouverture du fichier 2 *******
' *****************************************
' Déclaration des noms des fichiers à traiter
Nom2 = "nom2"
Path2 = PathGen & Lib & "." & Nom2 & "\"
NomOuverture = Path2 & Nom2 & ".xls"
NomAUtiliser = Path2 & Nom2 & NomVariante & ".txt"
ChDir Path2
Workbooks.Open Filename:=NomOuverture, UpdateLinks:=3
' Sauvegarde
ActiveWorkbook.Save
' Exportation du fichier texte
Sheets("maLib.nom2").Select
ActiveWorkbook.SaveAs Filename:=NomAUtiliser, FileFormat:=xlText, CreateBackup:=False
' Fermeture du fichier sans sauvegarde
ActiveWindow.Close SaveChanges:=False
' Ouverture du fichier texte pour changer les virgules en points
ChDir Path2
Workbooks.OpenText Filename:=NomAUtiliser, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True _
, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1) _
, Array(2, 1))
Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False
ActiveWorkbook.Save
' Fermeture du fichier texte
ActiveWindow.Close SaveChanges:=False
' Message avant fermeture
MsgBox ("Fichiers textes créés, vérifiez les avant de les exporter")
ActiveWindow.Close SaveChanges:=False |
Partager