Récupération de données dans un fichier RTF

Bonjour,

Le code suivant peut-il vous aider ?

'**********************
Option Explicit
Sub CopieRTFversEXCEL()
Dim Doc As Object
Set Doc = GetObject("C:jacqueshsortie.rtf")
Doc.Range.Copy
Sheets.Add Before:=Sheets(1)
ActiveSheet.Paste
Set Doc = Nothing
End Sub
'**********************

Cordialement.

PMO
Patrick Morange

Bonjour à toutes et à tous,

J'ai un petit problème que je n'arrive pas à régler, malgré de
nombreuses consultations de l'historique du forum.

Je suis dans un fichier EXCEL (97 sous Windows 98), et je veux
coller dans une des feuilles (Feuil2) des données qui proviennent d'un
fichier RTF nommé "sortie.rtf".
Quelqu'un peut-il me dire si c'est possible ?

Si oui, il me faut :
- Ouvrir le document Essai.rtf. je pense avoir réussi avec
le code suivant :
MyAppID = Shell("Winword.EXE
C:jacqueshsortie.rtf", 1)


- Sélectionner le texte à récupérer et le coller dans EXCEL
(je suis bloqué).

- Pour corser le tout : dans le fichier "sortie.rtf", je
dois récupérer les données d'un tableau de 7 colonnes sur un nombre de
lignes qui est aléatoire. Ce tableau n'est pas forcément sur la première
page, par contre, il commence toujours par les mêmes en-têtes de
colonnes.

Merci pour votre aide.

Jacques.

Bonjour,

Merci pour la réponse ultra-rapide.

C'est un très bon début car, même si je n'ai pas encore tout compris dans le
code, j'ai réussi à ouvrir le fichier RTF et à coller l'ensemble de ses données
dans EXCEL.

Ce qui reste à améliorer :
Je ne souhaite pas créer une nouvelle feuille mais coller les
informations dans une feuille déjà existante (Feuil2).

De plus, est-il possible, dans le fichier RTF de sélectionner quelque
chose de particulier : par exemple les données d'un tableau qui commence par des
en-têtes de colonnes toujours identiques et se terminent après un nombre de
lignes aléatoire.

Cordialement.

Bonjour,

Le code suivant peut-il vous aider ?

'**********************
Option Explicit
Sub CopieRTFversEXCEL()
Dim Doc As Object
Set Doc = GetObject("C:jacqueshsortie.rtf")
Doc.Range.Copy
Sheets.Add Before:=Sheets(1)
ActiveSheet.Paste
Set Doc = Nothing
End Sub
'**********************

Cordialement.

PMO
Patrick Morange

Bonjour à toutes et à tous,

J'ai un petit problème que je n'arrive pas à régler, malgré de
nombreuses consultations de l'historique du forum.

Je suis dans un fichier EXCEL (97 sous Windows 98), et je veux
coller dans une des feuilles (Feuil2) des données qui proviennent d'un
fichier RTF nommé "sortie.rtf".
Quelqu'un peut-il me dire si c'est possible ?

Si oui, il me faut :
- Ouvrir le document Essai.rtf. je pense avoir réussi avec
le code suivant :
MyAppID = Shell("Winword.EXE
C:jacqueshsortie.rtf", 1)


- Sélectionner le texte à récupérer et le coller dans EXCEL
(je suis bloqué).

- Pour corser le tout : dans le fichier "sortie.rtf", je
dois récupérer les données d'un tableau de 7 colonnes sur un nombre de
lignes qui est aléatoire. Ce tableau n'est pas forcément sur la première
page, par contre, il commence toujours par les mêmes en-têtes de
colonnes.

Merci pour votre aide.

Jacques.

Rebonjour,

Plutôt que d'essayer de reconnaître votre tableau dans le .RTF,
pourquoi ne pas le rechercher dans la feuille qui se crée automatiquement ?

Dans la mesure où les colonnes et les lignes de votre tableau sont
adjacentes il sera facile de le prèlever et de le transférer dans
votre feuille "Feuil2". Pouvez-vous me dire si tel est le cas ?
Indiquez-moi, par la même occasion, les titres de vos 7 colonnes dans
l'ordre où elles apparaissent et précisez si ces titres ont plusieurs
occurences (si oui cela représente un obstacle).
On pourra, par la suite, détruire par programme la feuille crée
automatiquement
et qui ne vous servira plus à rien.

A suivre...
Cordialement.

PMO
Patrick Morange

Rebonjour,

J'ai été obligé de m'absenter hier soir et je n'ai pu poursuivre la
conversation.

Je suis très intéressé par l'idée que vous proposez, malheureusement je ne
sais pas comment faire.

En fait, ce matin, j'ai contourné le problème en m'apercevant que les
données qui précédent le tableau ont moins de colonnes que le tableau lui-même.
J'ai donc supprimé toutes les lignes qui n'ont pas d'informations en colonne 7
et cela fonctionne. Voici mon code :

Option Explicit
Sub CopieRTFversEXCEL()
Application.ScreenUpdating = False
Dim Doc As Object
Set Doc = GetObject("C:jacqueshsortie.rtf")
Doc.Range.Copy
Sheets("Index").Activate
Cells.Select
Selection.ClearContents
Range("A1").Select
ActiveSheet.Paste
Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
Set Doc = Nothing
End Sub

Cependant, la solution n'est pas complètement sùre dans la mesure où un
jour, il peut y avoir une ou plusieurs lignes qui précèdent le tableau et qui
contiennent des informations en colonne 7.
Voici les titres des en-têtes de colonnes de mon tableau :
Obs - Animal - Sexe - Index - Pd70j - Vgrdt - Vgpctg

Merci pour votre aide.

Jacques

Rebonjour,

Plutôt que d'essayer de reconnaître votre tableau dans le .RTF,
pourquoi ne pas le rechercher dans la feuille qui se crée automatiquement ?

Dans la mesure où les colonnes et les lignes de votre tableau sont
adjacentes il sera facile de le prèlever et de le transférer dans
votre feuille "Feuil2". Pouvez-vous me dire si tel est le cas ?
Indiquez-moi, par la même occasion, les titres de vos 7 colonnes dans
l'ordre où elles apparaissent et précisez si ces titres ont plusieurs
occurences (si oui cela représente un obstacle).
On pourra, par la suite, détruire par programme la feuille crée
automatiquement
et qui ne vous servira plus à rien.

A suivre...
Cordialement.

PMO
Patrick Morange

Bonjour,

Voici un code amélioré inspiré du votre.
ATTENTION: la feuille de réception "Index" (selon votre code) sera
systématiquement virginisée à chaque lancement de la macro.
Si vous avez travaillé dessus renommez la.

CELA FAIT:
1) un tableau "titres" des variables à retrouver pour se caler
2) vérification de l'existence de la feuille de réception
3) sélection du fichier RTF à traiter par boîte de dialogues
4) création d'une feuille temporaire dans laquelle est monté le RTF
5) balayage de la feuille temporaire pour y trouver la ligne et la colonne
de la cellule contenant la 1ère variable de titres (en l'occurence "Obs")
en prenant soin de virer les éventuels espaces (Trim) et de ne pas
distinguer la casse (minuscules vs majuscules (Ucase))
6) définir la plage concernée et faire une copie
7) virginiser la feuille de réception ("Index") et y coller la plage concernée
8) détruire la feuille temporaire

'***********************
Option Explicit
'###########################################
'### Ci-dessous le nom de la feuille où ###
'### s'inscrira le résultat. J'ai pris ###
'### "Index" en me basant sur votre code ###
'### mais vous pouvez modifier "Index" ###
'### par "TOTO" par exemple ###
Const FEUIL_RECEPTION As String = "Index"
'###########################################
Sub CopieRTFversEXCEL()
Dim S As Worksheet
Dim fichier
Dim titres
Dim Doc As Object
Dim var
Dim i&
Dim j&
Dim k&
Dim bool As Boolean
Dim lig&
Dim col&
Dim R As Range
On Error GoTo Erreur
'---- Variables de calage ----
titres = Array("", "Obs", "Animal", "Sexe", _
"Index", "Pd70j", "Vgrdt", "Vgpctg")
'---- Existence de la feuille de réception ----
For Each S In Worksheets
If S.Name = FEUIL_RECEPTION Then
bool = True
Exit For
End If
Next S
If Not bool Then
MsgBox prompt:="La feuille de destination " _
& FEUIL_RECEPTION & " n'existe pas." & _
vbCrLf & "Veuillez la créer.", _
Title:="Programme stoppé"
Exit Sub
End If
bool = False
'---- Sélection du fichier RTF ----
fichier = Application. _
GetOpenFilename("Fichiers RTF,*.rtf")
If fichier = False Then Exit Sub
'---- Montée du RTF dans Excel ----
Set Doc = GetObject(fichier)
Doc.Range.Copy
Application.ScreenUpdating = False
Sheets.Add Before:=Sheets(1) 'feuille temporaire
ActiveSheet.Paste
Doc.Parent.Quit
Set Doc = Nothing
'---- Balayage pour se caler ----
var = ActiveSheet.UsedRange
For i& = 1 To UBound(var, 1)
For j& = 1 To UBound(var, 2)
If Trim(UCase(var(i&, j&))) = _
UCase(titres(1)) Then
bool = True
For k& = 2 To UBound(titres)
If Trim(UCase(var(i&, j& + k& - 1))) <> _
UCase(titres(k&)) Then bool = False
Next k&
End If
If bool Then
lig& = i& 'N° ligne du titre "Obs"
col& = j& 'N° colonne du titre "Obs"
Exit For
End If
Next j&
If bool Then Exit For
Next i&
'---- La plage trouvée ----
Set R = Sheets(1).Range(Cells(lig&, col&), _
Cells(lig&, col&)).CurrentRegion
'---- Feuille de réception ----
Sheets(FEUIL_RECEPTION).Activate
Cells.Delete
[a1].Select
R.Copy
ActiveSheet.Paste
[a1].Select
'---- Destruction de la feuille temporaire ----
Application.DisplayAlerts = False
Sheets(1).Delete
'---- Pseudo traitement erreur ----
Erreur:
Set Doc = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'***********************

Il n'y a plus qu'à essayer.

Cordialement.

PMO
Patrick Morange

Rebonjour,

J'ai été obligé de m'absenter hier soir et je n'ai pu poursuivre la
conversation.

Je suis très intéressé par l'idée que vous proposez, malheureusement je ne
sais pas comment faire.

En fait, ce matin, j'ai contourné le problème en m'apercevant que les
données qui précédent le tableau ont moins de colonnes que le tableau lui-même.
J'ai donc supprimé toutes les lignes qui n'ont pas d'informations en colonne 7
et cela fonctionne. Voici mon code :

Option Explicit
Sub CopieRTFversEXCEL()
Application.ScreenUpdating = False
Dim Doc As Object
Set Doc = GetObject("C:jacqueshsortie.rtf")
Doc.Range.Copy
Sheets("Index").Activate
Cells.Select
Selection.ClearContents
Range("A1").Select
ActiveSheet.Paste
Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
Set Doc = Nothing
End Sub

Cependant, la solution n'est pas complètement sùre dans la mesure où un
jour, il peut y avoir une ou plusieurs lignes qui précèdent le tableau et qui
contiennent des informations en colonne 7.
Voici les titres des en-têtes de colonnes de mon tableau :
Obs - Animal - Sexe - Index - Pd70j - Vgrdt - Vgpctg

Merci pour votre aide.

Jacques

Merci beaucoup. Je vais tester cela.

Cordialement

Jacques.

Bonjour,

Voici un code amélioré inspiré du votre.
ATTENTION: la feuille de réception "Index" (selon votre code) sera
systématiquement virginisée à chaque lancement de la macro.
Si vous avez travaillé dessus renommez la.

CELA FAIT:
1) un tableau "titres" des variables à retrouver pour se caler
2) vérification de l'existence de la feuille de réception
3) sélection du fichier RTF à traiter par boîte de dialogues
4) création d'une feuille temporaire dans laquelle est monté le RTF
5) balayage de la feuille temporaire pour y trouver la ligne et la colonne
de la cellule contenant la 1ère variable de titres (en l'occurence "Obs")
en prenant soin de virer les éventuels espaces (Trim) et de ne pas
distinguer la casse (minuscules vs majuscules (Ucase))
6) définir la plage concernée et faire une copie
7) virginiser la feuille de réception ("Index") et y coller la plage concernée
8) détruire la feuille temporaire

'***********************
Option Explicit
'###########################################
'### Ci-dessous le nom de la feuille où ###
'### s'inscrira le résultat. J'ai pris ###
'### "Index" en me basant sur votre code ###
'### mais vous pouvez modifier "Index" ###
'### par "TOTO" par exemple ###
Const FEUIL_RECEPTION As String = "Index"
'###########################################
Sub CopieRTFversEXCEL()
Dim S As Worksheet
Dim fichier
Dim titres
Dim Doc As Object
Dim var
Dim i&
Dim j&
Dim k&
Dim bool As Boolean
Dim lig&
Dim col&
Dim R As Range
On Error GoTo Erreur
'---- Variables de calage ----
titres = Array("", "Obs", "Animal", "Sexe", _
"Index", "Pd70j", "Vgrdt", "Vgpctg")
'---- Existence de la feuille de réception ----
For Each S In Worksheets
If S.Name = FEUIL_RECEPTION Then
bool = True
Exit For
End If
Next S
If Not bool Then
MsgBox prompt:="La feuille de destination " _
& FEUIL_RECEPTION & " n'existe pas." & _
vbCrLf & "Veuillez la créer.", _
Title:="Programme stoppé"
Exit Sub
End If
bool = False
'---- Sélection du fichier RTF ----
fichier = Application. _
GetOpenFilename("Fichiers RTF,*.rtf")
If fichier = False Then Exit Sub
'---- Montée du RTF dans Excel ----
Set Doc = GetObject(fichier)
Doc.Range.Copy
Application.ScreenUpdating = False
Sheets.Add Before:=Sheets(1) 'feuille temporaire
ActiveSheet.Paste
Doc.Parent.Quit
Set Doc = Nothing
'---- Balayage pour se caler ----
var = ActiveSheet.UsedRange
For i& = 1 To UBound(var, 1)
For j& = 1 To UBound(var, 2)
If Trim(UCase(var(i&, j&))) = _
UCase(titres(1)) Then
bool = True
For k& = 2 To UBound(titres)
If Trim(UCase(var(i&, j& + k& - 1))) <> _
UCase(titres(k&)) Then bool = False
Next k&
End If
If bool Then
lig& = i& 'N° ligne du titre "Obs"
col& = j& 'N° colonne du titre "Obs"
Exit For
End If
Next j&
If bool Then Exit For
Next i&
'---- La plage trouvée ----
Set R = Sheets(1).Range(Cells(lig&, col&), _
Cells(lig&, col&)).CurrentRegion
'---- Feuille de réception ----
Sheets(FEUIL_RECEPTION).Activate
Cells.Delete
[a1].Select
R.Copy
ActiveSheet.Paste
[a1].Select
'---- Destruction de la feuille temporaire ----
Application.DisplayAlerts = False
Sheets(1).Delete
'---- Pseudo traitement erreur ----
Erreur:
Set Doc = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'***********************

Il n'y a plus qu'Ã essayer.

Cordialement.

PMO
Patrick Morange

Rebonjour,

J'ai été obligé de m'absenter hier soir et je n'ai pu poursuivre la
conversation.

Je suis très intéressé par l'idée que vous proposez, malheureusement je ne
sais pas comment faire.

En fait, ce matin, j'ai contourné le problème en m'apercevant que les
données qui précédent le tableau ont moins de colonnes que le tableau lui-même.
J'ai donc supprimé toutes les lignes qui n'ont pas d'informations en colonne 7
et cela fonctionne. Voici mon code :

Option Explicit
Sub CopieRTFversEXCEL()
Application.ScreenUpdating = False
Dim Doc As Object
Set Doc = GetObject("C:jacqueshsortie.rtf")
Doc.Range.Copy
Sheets("Index").Activate
Cells.Select
Selection.ClearContents
Range("A1").Select
ActiveSheet.Paste
Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
Set Doc = Nothing
End Sub

Cependant, la solution n'est pas complètement sùre dans la mesure où un
jour, il peut y avoir une ou plusieurs lignes qui précèdent le tableau et qui
contiennent des informations en colonne 7.
Voici les titres des en-têtes de colonnes de mon tableau :
Obs - Animal - Sexe - Index - Pd70j - Vgrdt - Vgpctg

Merci pour votre aide.

Jacques