Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afin d’a

U

UJAP

XLDnaute Occasionnel
Automatiser la mise page d'un fichier

Salut,

J’aurai besoin de vos aides afin d’automatiser l’importation d’un fichier .txt sur Excel. Tous les mois dans le cadre de mon travail, je transfère sur Excel un fichier txt. Extrait de notre logiciel.

Ainsi tous les mois par l’intermédiaire de l’assistant d’importation je défini des colonnes de largeurs fixes. Ces colonnes sont identiques d’un mois sur l’autre.

Alors pourrait-on imaginer d’une manière ou d’une autre automatiser cette tâche qui consiste à définir des colonnes ?

Les colonnes sont définies par rapport aux intitulés des colonnes : Coll – Emp – N° tiers – Reg Cot – Lib rub – ind cot – lib – base – taux – montant – nombre –agent sexe

Je vous joints en pièce jointe le fichier txt (exemple) + impression d’écran importation

Merci pour votre aide,
 

Pièces jointes

  • Image-1.jpg
    Image-1.jpg
    52.2 KB · Affichages: 53
  • Exemple-fichier txt.zip
    1.2 KB · Affichages: 27
Dernière édition:
Trier par date Trier par votes
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

Bonjour UJAP,

le plus simple est sans doute d'enregistrer une macro pendant l'import de ton fichier texte. A partir du code généré, on pourra t'aider à l'adapter...
 
Vote positif 0 Vote négatif
U

UJAP

XLDnaute Occasionnel
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

OK,

Je viens d’enregistrer un macro de l’ouverture à la mise en page du fichier,

Ci-joint le macro :
Sub Importation()
'
' Importation Macro
' Macro enregistrée le 13/11/2008 par
'

'
ChDir "C:\Documents and Settings\Utilisateur\Mes documents\Cotisat°"
Workbooks.OpenText Filename:= _
"C:\Documents and Settings\Utilisateur\Mes documents\Cotisat°\gpecotbu1726.lis" _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(12, 1), Array(18, 1), Array(25, 1), Array(33, 1), Array(45, 1), _
Array(50, 1), Array(58, 1), Array(80, 1), Array(94, 1), Array(103, 1), Array(118, 1), Array _
(127, 1)), TrailingMinusNumbers:=True
End Sub

Sauf que la macro sur ce fichier « gpecotbu1726.lis » alors que je voudrais d’abord sélectionner mon fichier puis lancer le macro ? sans avoir outil importation,

Peut-on imaginer que dans excel avoir une cellule où je rentre le nom du fichier (qui sera différent chaque mois) puis ensuite lancer le macro qui ira effectuer importation du fichier et sa mise en page ?
 
Dernière édition:
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

à tester :

Code: 
Sub Importation()
Dim DialOuvr As FileDialog, Rep, Chemin As String
    Set DialOuvr = Application.FileDialog(msoFileDialogOpen)
    DialOuvr.Filters.Clear
    DialOuvr.Filters.Add "Fichiers Texte", "*.txt", 1
    DialOuvr.AllowMultiSelect = False
    DialOuvr.Title = "Choix du fichier texte à importer"
    DialOuvr.InitialView = msoFileDialogViewList
    Rep = DialOuvr.Show
        If Rep = 0 Then
            MsgBox "Opération annulée"
            Exit Sub
        End If
    Chemin = DialOuvr.SelectedItems(1)
    Workbooks.OpenText Filename:=Chemin _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
        Array(Array(0, 1), Array(12, 1), Array(18, 1), Array(25, 1), Array(33, 1), Array(45, 1), _
        Array(50, 1), Array(58, 1), Array(80, 1), Array(94, 1), Array(103, 1), Array(118, 1), Array _
        (127, 1)), TrailingMinusNumbers:=True
End Sub
 
Vote positif 0 Vote négatif
U

UJAP

XLDnaute Occasionnel
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

Le code fonctionne, Génial,

Et si je veux rajouter les fichiers avec extension en .lis (fichiers extraits de notre logiciel) ? Autrement je rajouter ce code à la suite ?

Merci,


Sub EffaceRecopie()
Dim k As Integer, i As Integer, j As Integer 'déclaration des variables
On Error Resume Next
Application.ScreenUpdating = False 'désactivation du rafraichissement d'écran
Rows("1:8").Delete 'effacement lignes 1 à 8
For k = ActiveSheet.UsedRange.Rows.Count To 2 Step -1 'boucle n° de la dernière ligne de la feuille jusqu'à 2
If Cells(k, 13) <> "M" And Cells(k, 13) <> "F" Then Rows(k).Delete 'si valeur col M ligne k on supprime la ligne
Next k 'n° ligne suivant
For i = 1 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count 'boucle n° de la dernière ligne de la plage jusqu'à 2
For j = 1 To 8 'boucle n° colonne 1 à 8
If Cells(i, j) = "" Then Cells(i, j) = Cells(i - 1, j) 'si cel vide on copie la valeur de la cel précédente
Next j 'n° colonne suivant
Range("I" & i & ":K" & i).Replace What:=".", Replacement:=",", LookAt:=xlPart * 1 'remplacement "." par "," col I,J,K
Range("N" & i) = Format(Date, "mm/dd/yyyy") 'col N = date du jour
Range("I" & i).Value = Range("I" & i) * 1
Range("J" & i).Value = Range("J" & i) * 1
Range("K" & i).Value = Range("K" & i) * 1
Range("I" & i & ":K" & i).NumberFormat = "#,##0.00"
Next i 'n° ligne suivant
Range("N1") = "DATE" 'texte cellule N1
ActiveSheet.Shapes("Bouton 1").Delete 'la macro effaçant les 8 première lignes je préfère supprimer le bouton
Application.ScreenUpdating = True 'réactivation du rafraichissement d'écran

End Sub
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

euh, oui, je ne peux pas ouvrir les zip, alors je n'avais pas vu le code existant.

ajoute

DialOuvr.Filters.Add "Fichiers LIS", "*.lis", 1

après la ligne analogue avec "*.txt"

et mets ton code existant à la suite, je pense que ça doit passer
 
Vote positif 0 Vote négatif
U

UJAP

XLDnaute Occasionnel
Re : Automatiser la mise page d'un fichier

MErci,

Je te transmets en pièce jointe les codes pour savoir si on peut les regrouper,

Merci,
 

Pièces jointes

  • codes.zip
    1.2 KB · Affichages: 20
  • codes.zip
    1.2 KB · Affichages: 23
  • codes.zip
    1.2 KB · Affichages: 24
Vote positif 0 Vote négatif
U

UJAP

XLDnaute Occasionnel
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

Ci jt. les 2 codes,

Code 1 : Importation du fichier :

Sub Importation()
Dim DialOuvr As FileDialog, Rep, Chemin As String
Set DialOuvr = Application.FileDialog(msoFileDialogOpen)
DialOuvr.Filters.Clear
DialOuvr.Filters.Add "Fichiers Texte", "*.txt", 1
DialOuvr.Filters.Add "Fichiers LIS", "*.lis", 1
DialOuvr.AllowMultiSelect = False
DialOuvr.Title = "Choix du fichier texte à importer"
DialOuvr.InitialView = msoFileDialogViewList
Rep = DialOuvr.Show
If Rep = 0 Then
MsgBox "Opération annulée"
Exit Sub
End If
Chemin = DialOuvr.SelectedItems(1)
Workbooks.OpenText Filename:=Chemin _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(12, 1), Array(18, 1), Array(25, 1), Array(33, 1), Array(45, 1), _
Array(51, 1), Array(59, 1), Array(80, 1), Array(94, 1), Array(103, 1), Array(118, 1), Array _
(127, 1)), TrailingMinusNumbers:=True
End Sub

Code 2 : Mise en page du fichier


Sub EffaceRecopie()
Dim k As Integer, i As Integer, j As Integer 'déclaration des variables
On Error Resume Next
Application.ScreenUpdating = False 'désactivation du rafraichissement d'écran
Rows("1:8").Delete 'effacement lignes 1 à 8
For k = ActiveSheet.UsedRange.Rows.Count To 2 Step -1 'boucle n° de la dernière ligne de la feuille jusqu'à 2
If Cells(k, 13) <> "M" And Cells(k, 13) <> "F" Then Rows(k).Delete 'si valeur col M ligne k on supprime la ligne
Next k 'n° ligne suivant
For i = 1 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count 'boucle n° de la dernière ligne de la plage jusqu'à 2
For j = 1 To 8 'boucle n° colonne 1 à 8
If Cells(i, j) = "" Then Cells(i, j) = Cells(i - 1, j) 'si cel vide on copie la valeur de la cel précédente
Next j 'n° colonne suivant
Range("I" & i & ":K" & i).Replace What:=".", Replacement:=",", LookAt:=xlPart * 1 'remplacement "." par "," col I,J,K
Range("N" & i) = Format(Date, "mm/dd/yyyy") 'col N = date du jour
Range("I" & i).Value = Range("I" & i) * 1
Range("J" & i).Value = Range("J" & i) * 1
Range("K" & i).Value = Range("K" & i) * 1
Range("I" & i & ":K" & i).NumberFormat = "#,##0.00"
Next i 'n° ligne suivant
Range("N1") = "DATE" 'texte cellule N1
ActiveSheet.Shapes("Bouton 1").Delete 'la macro effaçant les 8 première lignes je préfère supprimer le bouton
Application.ScreenUpdating = True 'réactivation du rafraichissement d'écran

End Sub
 
Vote positif 0 Vote négatif
U

UJAP

XLDnaute Occasionnel
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

J'ai essayé comme ceci mais le code fonctionne pas, j'ai fait une erreur ?

Sub Importation()
Dim DialOuvr As FileDialog, Rep, Chemin As String
Set DialOuvr = Application.FileDialog(msoFileDialogOpen)
DialOuvr.Filters.Clear
DialOuvr.Filters.Add "Fichiers Texte", "*.txt", 1
DialOuvr.AllowMultiSelect = False
DialOuvr.Title = "Choix du fichier texte à importer"
DialOuvr.InitialView = msoFileDialogViewList
Rep = DialOuvr.Show
If Rep = 0 Then
MsgBox "Opération annulée"
Exit Sub
End If
Chemin = DialOuvr.SelectedItems(1)
Workbooks.OpenText Filename:=Chemin _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(12, 1), Array(18, 1), Array(25, 1), Array(33, 1), Array(45, 1), _
Array(51, 1), Array(59, 1), Array(80, 1), Array(94, 1), Array(103, 1), Array(118, 1), Array _
(127, 1)), TrailingMinusNumbers:=True
EffaceRecopie
End Sub


Sub EffaceRecopie()
Dim k As Integer, i As Integer, j As Integer 'déclaration des variables
On Error Resume Next
Application.ScreenUpdating = False 'désactivation du rafraichissement d'écran
Rows("1:8").Delete 'effacement lignes 1 à 8
For k = ActiveSheet.UsedRange.Rows.Count To 2 Step -1 'boucle n° de la dernière ligne de la feuille jusqu'à 2
If Cells(k, 13) <> "M" And Cells(k, 13) <> "F" Then Rows(k).Delete 'si valeur col M ligne k on supprime la ligne
Next k 'n° ligne suivant
For i = 1 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count 'boucle n° de la dernière ligne de la plage jusqu'à 2
For j = 1 To 8 'boucle n° colonne 1 à 8
If Cells(i, j) = "" Then Cells(i, j) = Cells(i - 1, j) 'si cel vide on copie la valeur de la cel précédente
Next j 'n° colonne suivant
Range("I" & i & ":K" & i).Replace What:=".", Replacement:=",", LookAt:=xlPart * 1 'remplacement "." par "," col I,J,K
Range("N" & i) = Format(Date, "mm/dd/yyyy") 'col N = date du jour
Range("I" & i).Value = Range("I" & i) * 1
Range("J" & i).Value = Range("J" & i) * 1
Range("K" & i).Value = Range("K" & i) * 1
Range("I" & i & ":K" & i).NumberFormat = "#,##0.00"
Next i 'n° ligne suivant
Range("N1") = "DATE" 'texte cellule N1
ActiveSheet.Shapes("Bouton 1").Delete 'la macro effaçant les 8 première lignes je préfère supprimer le bouton
Application.ScreenUpdating = True 'réactivation du rafraichissement d'écran

End Sub
 
Vote positif 0 Vote négatif
U

UJAP

XLDnaute Occasionnel
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

Quand j'exécute le code modifié je n'arrive pas au résultat souhaité,

Donc je sais pas si j'ai effectué les bonnes manipulations pour assembler les 2 codes,
 
Vote positif 0 Vote négatif
U

UJAP

XLDnaute Occasionnel
Re : Automatiser la mise page d'un fichier TxtSalut, J’aurai besoin de vos aides afi

Ok, je te remercie, car tu m’as vraiment aidé,

Je vais mettre un message dans le forum pour fusionner mes 2 codes car je sais pas comment le faire,
 
Vote positif 0 Vote négatif

Membres actuellement en ligne

14 membres et 207 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 038
Messages
2 084 824
Membres
102 681
dernier inscrit
racsam77