Récupération de texte dans une variable

Version imprimable

26/07/2011, 18h19
m@tix

1 pièce(s) jointe(s)

Récupération de texte dans une variable
Bonjour,

A partir de mon classeur actif, je tente de récupérer du texte issu d'un fichier texte dans une variable. Le problème est que le fichier en question est assez mal fait, dans le sens où le texte à récupérer se répartit sur plusieurs lignes (pour une même phrase). Ci-joint un modèle du fichier enregistré sous Excel pour vous donner une idée.

Mon but est d'obtenir le texte qui début en dessous de "Description", jusqu'au dernier mot. Je précise que si dans cet exemple le texte se termine ligne 11, cela peut différer d'un fichier à l'autre.

J'ai voulu commencer en tentant déjà de récupérer ne serait-ce que la première ligne dans une variable, impossible en faisant ceci:
Code:

1 2 3 Dim texte As Variant 'ou String, mais ça ne change rien... texte = Workbooks(mon_fichier).Cells(3, 1) 'j'ai également essayé avec Range, rien n'y fait
Auriez-vous quelque chose à me suggérer ?

Merci d'avance ! ;)

Bonjour,

J'ai précisé la feuille

Code:

1
2
3
4
5
6
7
8
9
Sub Test()
Dim texte As String
    With Worksheets("Feuil1") ' A adapter
        For i = 2 To Range("A" & .Rows.Count).End(xlUp).Row
            texte = texte & " " & .Cells(i, 1)
        Next i
    End With
    MsgBox texte
End Sub

Cordialement.

Pour ouvrir un fichier Excel et récupérer des données dans la colonne A de la première feuille à partir de la cellule contenant le mot Description

Code:

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
Private Function MonTexte(Fichier As String) As String
Dim Wbk As Workbook
Dim c As Range
Dim LastLig As Long, i As Long
Dim Texte As String
 
Application.ScreenUpdating = False
Set Wbk = Workbooks.Open(Fichier)
With Wbk.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set c = .Range("A1:A" & LastLig).Find("Description", LookIn:=xlValues, Lookat:=xlPart)
    If Not c Is Nothing Then
        If LastLig > c.Row Then
            For i = c.Row + 1 To LastLig
                If .Range("A" & i).Value <> "" Then Texte = Texte & " " & Trim(.Range("A" & i))
            Next i
        End If
        Set c = Nothing
    End If
End With
Wbk.Close False
Set Wbk = Nothing
MonTexte = Trim(Texte)
End Function
 
Private Sub TEST()
 
Debug.Print MonTexte("C:\Users\user\Desktop\modele.xls")
End Sub

27/07/2011, 00h08
m@tix

Bonsoir,

Merci à tous les deux pour vos réponses ! :D
Je regarde ça en détails demain matin, et je fais un retour dans la foulée. ;)
Tout de même.. Pouvez-vous m'expliquer pourquoi avec mon code je ne pouvais récupérer de texte (pas d'erreur au niveau de l'ouverture et/ou de la sélection du bon classeur/feuille, j'avais contrôlé).

Bonne soirée !
27/07/2011, 09h27
m@tix

Bonjour !

Je viens de jeter un oeil aux deux codes, et de les tester. :ccool:

Vos deux codes me rendent le même "résultat", l'avantage de celui de mercatog étant que s'il se trouvait que le commencement du texte venait à changer de ligne, le fait de chercher Description et de récupérer ce que l'on trouve après peut éviter certaines déconvenues.

Cependant, je ne saisis pas à quoi servent la ligne suivante, que j'ai d'ailleurs placée en commentaire car elles me fait planter à l'exécution:

Code:

Set Wbk = Nothing

Dernier point: comme vous l'aurez remarqué, le texte "s'organise" en paragraphes, débutant chacun par un tiret. Dans un souci de clarté, j'aimerais bien faire un ou deux saut de ligne entre chaque paragraphe... Là encore, j'ignore combien il y en aura selon le fichier. Je crois savoir que l'instruction vbCrLf pourra être utile. Mais je ne vois pas comment m'y prendre pour rechercher le fameux tiret...

Merci d'avance ! ;)

Bonjour
Wbk est une variable objet, on lui affect l'objet classeur qu'on a ouvert ici

Code:

Set Wbk = Workbooks.Open(Fichier)

A la fin du code, on vide cette variable par:

Code:

Set Wbk = Nothing

EDIT

Pour un retours en ligne avant le -

Code:

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
Private Function MonTexte(Fichier As String) As String
Dim Wbk As Workbook
Dim c As Range
Dim LastLig As Long, i As Long
Dim Texte As String, Phrase As String, Sep As String
 
Application.ScreenUpdating = False
Set Wbk = Workbooks.Open(Fichier)
With Wbk.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set c = .Range("A1:A" & LastLig).Find("Description", LookIn:=xlValues, Lookat:=xlPart)
    If Not c Is Nothing Then
        If LastLig > c.Row Then
            For i = c.Row + 1 To LastLig
                Phrase = .Range("A" & i).Value
                If Phrase <> "" Then
                    If Left(Phrase, 1) = "-" Then
                        Sep = vbCrLf
                        Phrase = Mid(Phrase, 2)
                    Else
                        Sep = " "
                    End If
                    Texte = Texte & Sep & Trim(Phrase)
                End If
            Next i
        End If
        Set c = Nothing
    End If
End With
Wbk.Close False
Set Wbk = Nothing
MonTexte = Trim(Texte)
End Function

27/07/2011, 11h51
m@tix

Ok, merci pour l'explication, ainsi que pour le nouveau code. Juste parce que je suis un peu pointilleux :mrgreen: : les tirets disparaissent du coup avec le nouveau code... Si je souhaite les conserver, et mettre un espace entre chaque tiret et le début de la phrase ? :mrgreen:

Edit: et même une dernière remarque ! :P On a bien un saut de ligne entre les deux "phrases", mais on en trouve malheureusement un autre avant le premier... C'est un peu ennuyeux, dans le sens où si l'on trouve beaucoup de messages, il y aura un grand espace au début... Est-ce possible de corriger ceci ?

Désolé pour toutes questions d'un coup, et merci d'avance !

Sur ton fichier le premier paragraphe juste après "- Description"

Citation:

Première ligne de la phrase suivie de....

ensuite des lignes vides et enfin ce paragraphe

Citation:

-Autre phrase blablablba

Le code modifié (que tu peux adapter à ton fichier original, en aucun cas je ne peux deviner toutes les variantes)

Code:

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
Private Function MonTexte(Fichier As String) As String
Dim Wbk As Workbook
Dim c As Range
Dim LastLig As Long, i As Long
Dim Texte As String, Phrase As String, Sep As String
 
Application.ScreenUpdating = False
Set Wbk = Workbooks.Open(Fichier)
With Wbk.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set c = .Range("A1:A" & LastLig).Find("Description", LookIn:=xlValues, Lookat:=xlPart)
    If Not c Is Nothing Then
        If LastLig > c.Row Then
            Texte = "-"
            For i = c.Row + 1 To LastLig
                Phrase = .Range("A" & i).Value
                If Phrase <> "" Then
                    If Left(Phrase, 1) = "-" Then
                        Sep = vbCrLf
                        Phrase = "- " & Mid(Phrase, 2)
                    Else
                        Sep = " "
                    End If
                    Texte = Texte & Sep & Trim(Phrase)
                End If
            Next i
        End If
        Set c = Nothing
    End If
End With
Wbk.Close False
Set Wbk = Nothing
MonTexte = Trim(Texte)
End Function

27/07/2011, 13h45
m@tix

Je viens de faire un pas à pas de la fonction pour mieux comprendre. En ressort deux remarques:

- Si je m'en tiens à l'espion mis en place sur la variable Texte, celle-ci devrait contenir du texte débutant par deux tirets, alors qu'au final, il n'en ressort qu'un (tant mieux ! :D). Je ne m'explique juste pas pourquoi.

- Mis à part ça c'est presque exactement ce que je voulais, reste juste un détail qui m'ennuie encore: le résultat final que j'ai affiché dans une msgbox fait apparaître une première ligne avec seulement un tiret avant les deux paragraphes suivants... Je ne vois pas comment éviter qu'elle s'affiche. Mis à part ça, il ne devrait pas y avoir d'autre "variante".

P.S.: dans mon second post, je demandais pourquoi le code que j'avais mis dans mon premier post ne permettait pas de récupérer du texte... je persiste, j'amerais savoir... :roll:

Merci encore pour ton aide. :ccool:

Edit: je viens de m'apercevoir d'une erreur de ma part sur le fichier que j'ai joint. Le tiret devant "Description" n'a en fait pas lieu d'être, il est en fait sur la ligne en dessous évidemment... :oops: Autant pour moi..
27/07/2011, 14h40
mercatog

Code:

texte = Workbooks(mon_fichier).Cells(3, 1)

Une cellule appartient à une feuille et cette feuille appartient au classeur

Tu devais écrire:

Code:

texte=workbooks(X).worksheets(Y).cells(i,j)
27/07/2011, 15h16
m@tix

Même lorsqu'il n'y a qu'une seule feuille dans le classeur ?

J'ai "résolu" l'histoire des tirets, mais je ne parviens pas à ne faire apparaître que le texte, sans la ou les lignes entre Description et les paragraphes...

Bonsoir,

Je me permets d'insister un peu concernant la modification du code précédent pour éviter de récupérer la ou les lignes vides entre Description et le premier paragraphe... J'ai eu beau essayer, je n'y parviens pas.. :calim2:
28/07/2011, 12h42
mercatog
Peut être tu as un espace (ou un retours chariot invisible)
Change les lignes 16 et 17 de la fonction MonTexte (la dernière) par ceci:
Code:

1 2 Phrase = Trim(.Range("A" & i).Value) If Len(Phrase) > 1 Then
28/07/2011, 15h04
m@tix

Merci pour ta réponse mercatog. Cependant, cela n'a rien changé. J'ai réaxaminé le code appliqué à mon fichier pour voir d'où pouvait venir ce premier saut de ligne avant l'apparition du premier paragraphe, et je pense avoir trouvé, sans pour autant avoir résolu le problème.

Dans ton dernier code, on a:

Code:

Sep = vbCrLf

On met dans Sep un saut de ligne, et par la suite, on a:

Code:

Texte = Texte & Sep & Trim(Phrase)

Au premier passage, Texte est vide et donc on commence par Sep, soit un saut de ligne. Es-tu d'accord ?

Si oui, je ne vois pas comment changer cela... J'attends ton avis ! ;)
28/07/2011, 15h30
mercatog

Mets ton fichier modele.xls en pj (fidèle en disposition au fichier réel) pour pouvoir me prononcer.

1 pièce(s) jointe(s)

Le voici !

Précision: ne tiens plus compte à présent des sauts de ligne entre Description et le début du premier paragraphe, j'ai ajouté les lignes suivantes à ta fonction qui permettent à présent de gérer ça:
Code:

1 2 3 debut = Workbooks(xxx).Worksheets(feuille1).Range("A:A").Find("Description", LookIn:=xlValues, lookat:=xlWhole).Row + 1 fin = Workbooks(xxx).Worksheets(feuille1).Range("A:A").Find("-", LookIn:=xlValues, lookat:=xlPart).Row - 1 Workbooks(xxx).Worksheets(feuille1).Rows(debut & ":" & fin).Delete

Testé sur ton dernier fichier exemple

Code:

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
Private Function MonTexte(Fichier As String) As String
Dim Wbk As Workbook
Dim c As Range
Dim LastLig As Long, i As Long
Dim Texte As String, Phrase As String, Sep As String
 
Application.ScreenUpdating = False
Set Wbk = Workbooks.Open(Fichier)
With Wbk.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set c = .Range("A1:A" & LastLig).Find("Description", LookIn:=xlValues, Lookat:=xlPart)
    If Not c Is Nothing Then
        If LastLig > c.Row Then
            For i = c.Row + 1 To LastLig
                Phrase = Trim(.Range("A" & i).Value)
                If Phrase <> "" Then
                    If Left(Phrase, 1) = "-" Then
                        Sep = vbCrLf
                        Phrase = "- " & Trim(Mid(Phrase, 2))
                    Else
                        Sep = " "
                    End If
                    Texte = IIf(Texte = "", "", Texte & Sep) & Trim(Phrase)
                End If
            Next i
        End If
        Set c = Nothing
    End If
End With
Wbk.Close False
Set Wbk = Nothing
MonTexte = Trim(Texte)
End Function

29/07/2011, 10h18
m@tix

C'est parfait, ça fonctionne très bien, et sur tous les fichiers à priori. :ccool:
On y est enfin parvenu ! :D
Encore une fois, merci beaucoup pour ton aide. ;)

Fuseau horaire GMT +2. Il est actuellement 22h47.