Transférer le contenu d'une zone rtf vers ms word

Commenter

Contenu du snippet

Le principe est assez simple : il suffit de copier l'info du RTF dans le Clipboard et de coller le tout dans la feuille Word (fonctionne très bien avec Excel). J'ai mis deux semaines à trouver toutes les infos mais aujourd'hui cela fonctionne très bien :)

Source / Exemple : 


-> Dans un fichier module.bas, copier le code suivant :
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function RegisterClipboardFormat Lib "user32" Alias _
    "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function SetClipboardData Lib "user32" ( _
    ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, Source As Any, ByVal Length As Long)
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" ( _
     ByVal hMem As Long) As Long

Public Const GMEM_DDESHARE = &H2000
Public Const GMEM_MOVEABLE = &H2

-> Derrière un bouton de commande, copiez le code suivant :
Dim sRTF As String
sRTF = RTF21.RTFtext   '<-- Ton contrôle RTF

'Copie le contenu de ta zone RTF dans la memoire du PC...
Dim lSuccess As Long
Dim lRTF As Long
Dim hGlobal As Long
Dim lpString As Long
lSuccess = OpenClipboard(Me.hwnd)
lRTF = RegisterClipboardFormat("Rich Text Format")
lSuccess = EmptyClipboard
hGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, Len(sRTF))
lpString = GlobalLock(hGlobal)

CopyMemory lpString, ByVal sRTF, Len(sRTF)
GlobalUnlock hGlobal
SetClipboardData lRTF, hGlobal
CloseClipboard
GlobalFree hGlobal

'...et colle le tout dans la cilbe choisie : ici Word
Dim oWord As Object
Dim oDoc As Object
Set oWord = CreateObject("word.application")
Set oDoc = oWord.Documents.Add

With oWord
    With .Selection
        .TypeText "CECI EST UN TEST" & Chr(11) & " ET C'EST TANT MIEUX"
        .TypeText vbCrLf & vbCrLf
        .Paste
        .TypeText vbCrLf & vbCrLf
        .TypeText "Bon courage !"
    End With
    .Visible = True
End With

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.