(Résolu) Ouvrir un fichier texte, sélectionner le texte et le copier en mémoire

LBi

XLDnaute Junior
Bonjour,
Je voudrais automatiser une étape de saisie avec une macro pour ouvrir un fichier txt grâce à l'explorateur Windows, puis sélectionner tout le texte du fichier le copier pour pouvoir l'intégrer dans ma macro1.
Pour l'instant, j'ouvre manuellement un fichier txt puis je sélectionne tout (CtrlA) je le copie (CtrlC) et j'appuie sur le bouton "Saisie" qui lance la macro1, puis je vais sur la ligne 4 Hémoglobine et je "colle les valeurs" en F4 pour le premier tableau.
Un autre souhait si cela est possible serait de pouvoir coller automatiquement le résultat dans la cellule de la ligne 4 de la première colonne vide F,J,N,R....
Merci
Je joins le fichier texte exemple et le tableau biologique
 

Fichiers joints

Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

Une première esquisse (pour ce qui est de l'ouverture du fichier TXT)
VB:
Sub OuvrirFichierTXT()
Dim Chemin$, NomFichier$
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Sélectionner votre fichier, svp": .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Fichiers TXT", "*.txt", 1: .FilterIndex = 1
    .InitialView = msoFileDialogViewProperties
        If .Show = -1 Then
        Chemin = .SelectedItems(1)
        'NomFichier = Dir(.SelectedItems(1))
        Workbooks.OpenText Chemin, StartRow:=6, DataType:=xlDelimited, Other:=True, OtherChar:="|"
        Else
        MsgBox "Vous n'avez pas sélectionné de fichier!", vbCritical, "ERREUR"
    End If
End With
End Sub
 

LBi

XLDnaute Junior
Bon comment vous dire ... Je voudrais que la macro, copie le texte du fichier txt ( super la boite de dialogue pour sélectionner le bon fichier ) en mémoire ( sans créer un fichier excel ) pour que la macro 1 puisse la traiter.
J’espère avoir été assez clair
Merci
 

Staple1600

XLDnaute Barbatruc
Re

Je te laisse tester et me redire si cela te convient mieux ? ;)
VB:
Sub OuvrirFichierEtUnPeuPlus()
Dim Chemin$, NomFichier$
ThisWorkbook.Sheets("Entrée").Cells.Clear
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Sélectionner votre fichier, svp": .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Fichiers TXT", "*.txt", 1: .FilterIndex = 1
    .InitialView = msoFileDialogViewProperties
        If .Show = -1 Then
        Chemin = .SelectedItems(1)
        'NomFichier = Dir(.SelectedItems(1))
        Application.ScreenUpdating = False
        Workbooks.OpenText Chemin, StartRow:=6, DataType:=xlDelimited, Other:=True, OtherChar:="|"
        ActiveWorkbook.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Entrée").Range("A1")
        Application.CutCopyMode = False
        ThisWorkbook.Sheets("Entrée").Columns("A:B").Delete
        ActiveWorkbook.Close False
        Else
        MsgBox "Vous n'avez pas sélectionné de fichier!", vbCritical, "ERREUR"
    End If
End With
End Sub
 

LBi

XLDnaute Junior
Bonjour ,
Quand j’exécute la macro, les formules dans "Nouvelle" indiquent !#REF! c'est je crois, le fait de supprimer les 2 premières colonnes dans "Entrée"
Je suis passé par "Feuil1" pour y remédier et ça fonctionne.
Je pense qu'il doit y avoir une solution sans passer par "Feuil1"

Pour mon second problème : coller automatiquement le résultat dans la cellule de la ligne 4 de la première colonne vide F,J,N,R....
Il faudrait peut être pouvoir tester la première cellule fusionnée vide ( Date d'examen ligne 3 colonnes FGHI )
Merci de vos contributions à ce projet qui va alléger grandement la saisie de données biologiques que l'on faisait jusque là manuellement.


Sub Macro1()
Dim Chemin$, NomFichier$
ThisWorkbook.Sheets("Entrée").Cells.Clear
ThisWorkbook.Sheets("Feuil1").Cells.Clear
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Sélectionner votre fichier, svp": .AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Fichiers TXT", "*.txt", 1: .FilterIndex = 1
.InitialView = msoFileDialogViewProperties
If .Show = -1 Then
Chemin = .SelectedItems(1)
'NomFichier = Dir(.SelectedItems(1))
Application.ScreenUpdating = False
Workbooks.OpenText Chemin, StartRow:=6, DataType:=xlDelimited, Other:=True, OtherChar:="|"
ActiveWorkbook.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Feuil1").Range("A1")
Application.CutCopyMode = False
ThisWorkbook.Sheets("Feuil1").Columns("A:B").Delete
ActiveWorkbook.Close False
Else
MsgBox "Vous n'avez pas sélectionné de fichier!", vbCritical, "ERREUR"
End If
End With
Sheets("Feuil1").Select
Columns("A:O").Select
Selection.Copy
Sheets("Entrée").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Nouvelle").Select
Range("F1:I120").Select
Selection.Copy
Sheets("T1").Select
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@LBi
Apparemment tu n'as compris que la macro du message#5 fait aussi ce que faisait ta macro1
(à savoir copier les données du fichier TXT dans la feuille Entrée)
Donc évidemment, il ne fallait pas ensuite ajouter le code de ta macro1 dans le mien.

Refais le test, lances ma macro* du message#5 et ensuite va voir le résultat en feuille Entrée.
(*telle que je l'ai postée)
 

LBi

XLDnaute Junior
Si si j'ai compris , mais il y a un bug comme je te l'indiquais dans mon dernier message "le fait de supprimer les 2 premières colonnes dans "Entrée"
Je suis passé par "Feuil1" pour y remédier et ça fonctionne".
 

Fichiers joints

Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@LBi
Pas besoin de la feuille " Feuil1" :rolleyes:
(Ni de tous ces "affreux" Select ;) )
VB:
Sub OuvrirFichierEtUnPeuPlusEtSansPasserParLaFeuille1()
Dim Chemin$, NomFichier$, t
t = Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1))
ThisWorkbook.Sheets("Entrée").Cells.Clear
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Sélectionner votre fichier, svp": .AllowMultiSelect = False: .Filters.Clear: .Filters.Add "Fichiers TXT", "*.txt", 1
    .FilterIndex = 1: .InitialView = msoFileDialogViewProperties
        If .Show = -1 Then
        Chemin = .SelectedItems(1): Application.ScreenUpdating = False
        Workbooks.OpenText Chemin, StartRow:=6, DataType:=xlDelimited, Other:=True, OtherChar:="|", FieldInfo:=t
        ActiveWorkbook.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Entrée").Range("A1")
        Application.CutCopyMode = False: ActiveWorkbook.Close False
        Else
        MsgBox "Vous n'avez pas sélectionné de fichier!", vbCritical, "ERREUR"
    End If
End With
End Sub
 

LBi

XLDnaute Junior
Merci
j'ai juste rajouté un peu de code pour pouvoir coller le résultat dans la feuille "T1"
Et pour mon second problème : coller automatiquement le résultat dans la cellule de la ligne 4 de la première colonne vide F,J,N,R....
Il faudrait peut être pouvoir tester la première cellule fusionnée vide ( Date d'examen ligne 3 colonnes FGHI ) ?
merci encore de votre contribution:)


Sub Macro1()

Dim Chemin$, NomFichier$, t
t = Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1))
ThisWorkbook.Sheets("Entrée").Cells.Clear
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Sélectionner votre fichier, svp": .AllowMultiSelect = False: .Filters.Clear: .Filters.Add "Fichiers TXT", "*.txt", 1
.FilterIndex = 1: .InitialView = msoFileDialogViewProperties
If .Show = -1 Then
Chemin = .SelectedItems(1): Application.ScreenUpdating = False
Workbooks.OpenText Chemin, StartRow:=6, DataType:=xlDelimited, Other:=True, OtherChar:="|", FieldInfo:=t
ActiveWorkbook.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Entrée").Range("A1")
Application.CutCopyMode = False: ActiveWorkbook.Close False
Sheets("Nouvelle").Select
Range("F1:I120").Select
Selection.Copy
Sheets("T1").Select

Else
MsgBox "Vous n'avez pas sélectionné de fichier!", vbCritical, "ERREUR"
End If
End With
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Bis répétita...
On peut se passer des Select (qui ralentisse l’exécution du code) :rolleyes:
Sheets("Nouvelle").Select
Range("F1:I120").Select
Selection.Copy
Sheets("T1").Select
peut simplement s'écrire
Sheets("Nouvelle").Range("F1:I120").Copy
Sheets("T1").Range("F4").PasteSpecial xlValues
 

LBi

XLDnaute Junior
Très bien, c'est noté ... mais du coup la sélection se copie toujours au même endroit (F4) et écrase les anciennes données.
 

Staple1600

XLDnaute Barbatruc
Re

@LBi
Qu'à cela ne tienne !...;)
Il suffit de parcourir les archives du forum pour trouver des discussions où l'on cause du moyen de déterminer la première cellule non vide d'une colonne.
(Souvent on y évoquera de commencer la recherche vers le bas, on pourra lire ce genre de code: DerLig As Long
ou bien encore: DerLig=Cells(Rows.Count,1).End...)
Pour consulter les archives, il suffit de cliquer ici
 

Staple1600

XLDnaute Barbatruc
Re

@LBi
Si jamais après tes recherches, tu ne trouvais pas chaussures à ton pied, je repasserai dans ton fil pour un autre bout de code ;)
Rectification:
C'est plutôt les discussions où l'on cherche à déterminer la première cellule* non vide sur une ligne donnée en partant de la droite vers la gauche
(*: son numéro de colonne)
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

@LBi
Rien trouvé de probant?
Bon, ma petite BA du vendredi soir (cela doit être l'effet de l'éclipse de lune)
VB:
Sub OuvrirFichierSuiteEtFin()
Dim Chemin$, NomFichier$, t
Dim DerCol&
DerCol = Sheets("T1").Cells(4, Columns.Count).End(xlToLeft).Column + 1
t = Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1))
ThisWorkbook.Sheets("Entrée").Cells.Clear
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Sélectionner votre fichier, svp": .AllowMultiSelect = False: .Filters.Clear: .Filters.Add "Fichiers TXT", "*.txt", 1
    .FilterIndex = 1: .InitialView = msoFileDialogViewProperties
        If .Show = -1 Then
        Chemin = .SelectedItems(1): Application.ScreenUpdating = False
        Workbooks.OpenText Chemin, StartRow:=6, DataType:=xlDelimited, Other:=True, OtherChar:="|", FieldInfo:=t
        ActiveWorkbook.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Entrée").Range("A1")
        Application.CutCopyMode = False: ActiveWorkbook.Close False
        Sheets("Nouvelle").Range("F1:I120").Copy
        Sheets("T1").Cells(4, DerCol).PasteSpecial xlValues
        Application.CutCopyMode = False
        Else
        MsgBox "Vous n'avez pas sélectionné de fichier!", vbCritical, "ERREUR"
    End If
End With
End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas