afficher un fichier .rtf

[stargate]

bonjour , est-il possible d'afficher un texte format rtf dans un cellule

si oui comment




Merci

 

[darib52]

bonsoir,
voici un extrait de code d'une macro qui permet de copier un fichier .doc ou .rtf dans excel.

si toutefois c'est là ta question.

Sub analyse()

Dim docWrd As Word.Application
Dim fichier As Variant


Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set Wrd = CreateObject('word.application')
Wrd.Visible = False
'affichage boite de dialogue pour choisir un document Word
fichier = Application.GetOpenFilename('Text Files (*.*), *.*')
If fichier = False Then Exit Sub

Set docwd = Wrd.documents.Open(fichier)
With docwd.Content.Find
.ClearFormatting
.Text = '.'
With .Replacement
.ClearFormatting
.Text = ' '
End With
.Execute Replace:=wdReplaceAll
.Forward = True
.Wrap = wdFindContinue
End With
docwd.Range.Find.Execute Replace:=wdReplaceAll
Wrd.Selection.WholeStory
Wrd.Selection.Copy
modele = Sheets('constantes').Range('r33')

 

[stargate]

Merci,

j'ai essayé ton code mais il me retourne une erreur à

Dim docWrd As Word.Application

l'erreur: Compile error:User-defined type not defined


une idée

 

[MichelXld]

bonjour Stargate , bonjour Darib52

dans l'editeur de macro (Alt+F11)
Menu Outils
References
Coche la ligne Microsoft Word xx.x Object Library
Clique sur OK pour valider

xx.x dépend de ta version d'Office


bon week end
MichelXld

 

[stargate]

merci MichelXld


mais il ne m'affiche rien dans la cellule
erreur de code?

voici le code

 Sub ProcInsFichier()
Dim docrtf As Word.Application
Dim fichier As Variant

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set wrd = CreateObject('word.application')
wrd.Visible = False
'Affichage boîte de dialogue pour choisir document .rtf

fichier = Application.GetOpenFilename('Textfiles(*.*),*.*')
If fichier = False Then Exit Sub

Set docrtf = wrd.documents.Open(fichier)

With docwd.Content.Find
.ClearFormatting
.Text = '.'
With .Replacement
.ClearFormatting
.Text = ''
End With
.Execute Replace:=wdReplaceAll
.Forward = True
.Wrap = wdFindContinue
End With
docwd.Range.Find.Execute Replace:=wdReplaceAll
wrd.Selection.WholeStory
wrd.Selection.Copy
modele = Sheets('Sheet1').Range('A1')




End Sub

Come c'est le code de darib52, est-il possible de mettre plus de commentaires merci

 

[MichelXld]

bonjour

c'est normal : la macro de Darib52 ne fait que remplacer les '.' par '' dans le document Word


tu peux essayer cette procedure

Sub ImporterWordVersExcel()
'necessite d'activer la reference microsoft Word xx.x Object Library
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim Wb As Workbook

Set Wb = Workbooks.Add(1)
Set AppWord = New Word.Application
AppWord.Visible = False
Set DocWord = _
AppWord.Documents.Open('C:\\\\\\\\monDocument.doc', ReadOnly:=True)

With AppWord
.Selection.WholeStory
.Selection.Copy
End With

Wb.ActiveSheet.Range('A1').Select
Wb.ActiveSheet.Paste
AppWord.Application.Quit
Application.CutCopyMode = False
End Sub



bonne journée
MichelXld

 

[stargate]

merci michel,

ton code marche ,mais il ecrit le fichier sur plusieurs cellules (par ex première ligne dans A1 et deuxième ligne dans A5)
est-il possible de mettre tout le contenu du fichier dans la cellule A1


merci

 

[MichelXld]

bonjour Stargate

tu peux utiliser cette adaptation

Sub ImporterWordVersExcel_V02()
'necessite d'activer la reference microsoft Word xx.x Object Library
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim Wb As Workbook
Dim Contenu As String

Set Wb = Workbooks.Add(1)
Set AppWord = New Word.Application
AppWord.Visible = False
Set DocWord = _
AppWord.Documents.Open('C:\\\\\\\\monDocument.doc', ReadOnly:=True)

Contenu = DocWord.Content

Wb.Sheets(1).Range('A1') = _
Application.WorksheetFunction.Substitute(Contenu, vbCr, vbLf)
End Sub


bonne soirée
MichelXld