Richtextbox i Access/Word

Du kan sagtens bruge en richedit, du skal bare vise/gemme xxx.TextRTF i fx et memo-felt.

"en richtext" selvfølgelig.

Du kan købe en proff. component fra FMS Inc.
http://www.fmsinc.com/products/memo/index.html

Om der findes nogen gratis ved jeg ikke.

hugopedersen: Kan jeg også indsætte den nævnte component i en Wordskabelon og indtaste richtext formatteret tekst til denne?

Der bliver jeg dig svar skyldig.  Check på webbet.

Det "eneste" du får ekstra i en købe-kontrol er automatisk databinding (i access - ikke word) og nemmere mulighed for at lave menuer og toolbars.

Selve kontrollen kan indeholde det samme som den "normale" RichTextBox.

Og det bliver ikke nemmere at koble den på databasen, end en normal RichTextBox, da du selv skal tilføje en datasource hvis du vil bruges den fra word.

Jeg ville nu nok fraråde at bruge en richtextbox på en skabelon, og i stedet bruge vba til at hente/gemme rtf i access. Blandt andet kan du ikke lade den gå over flere sider.

Jeg har noget kode (fra en tysker), som giver adgang til clipboardet fra vba, så man kan trække rtf ud af et dokument. (det er den eneste måde at få fat i rtf fra word, ud over at gemme som en rtf-fil og indlæse filen)
Så skal du bare have tilføjet at den skal gemme rtf'en (som reelt bare er tekst kodet på en bestemt måde) i databasen.

mortrr: Det lyder godt. Jeg ville blive glad, hvis jeg kunne se den kode, du taler om. Hvis det er ok, så send til christian_pihl_nielsen@oncable.dk
Tak

Lad os prøver her.
Kunne være andre også kan bruge det.

Opret et nyt Class module, navngiv det clipboard, og paste følgende ind:
============================================
Option Explicit

Private Const mModulName As String = "Clipboard"


#If VBA6 Then  ' Public Enum erst ab VBA 6 (Office 2000)
Public Enum ClipboardFormatEnum
    ' Textformate
    CF_TEXT = 1            ' Ansi-Text (Standard)
    CF_UNICODETEXT = 13    ' Text im Unicodeformat
    CF_OEMTEXT = 7          ' OEM Text
    CF_RTFTEXT = &HBF01&    ' Rich Text Format (.rtf file)
    ' Bildformate
    CF_BITMAP = 2          ' Bitmap (.bmp files)
    CF_METAFILEPICT = 3    ' Metafile (.wmf files)
    CF_DIB = 8              ' Device-independent bitmap (DIB)
    CF_PALETTE = 9          ' Farbpalette
    CF_ENHMETAFILE = 14    ' Erweitertes Metafile (.emf)
End Enum

#Else      ' Konstanten für Standardmodul (Access 97)

' Textformate
Const CF_TEXT          As Long = 1        ' Ansi-Text (Standard)
Const CF_UNICODETEXT    As Long = 13        ' Text im Unicodeformat
Const CF_OEMTEXT        As Long = 7        ' OEM Text
Const CF_RTFTEXT        As Long = &HBF01&  ' Rich Text Format (.rtf file)
' Bildformate
Const CF_BITMAP        As Long = 2        ' Bitmap (.bmp files)
Const CF_METAFILEPICT  As Long = 3        ' Metafile (.wmf files)
Const CF_DIB            As Long = 8        ' Device-independent bitmap (DIB)
Const CF_PALETTE        As Long = 9        ' Farbpalette
Const CF_ENHMETAFILE    As Long = 14        ' Erweitertes Metafile (.emf)
#End If

Private Const GHND As Long = &H42 ' GMEM_MOVEABLE | GMEM_ZEROINIT
Private Declare Function GlobalAlloc Lib "kernel32" ( _
    ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" ( _
    ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" ( _
    ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" ( _
    ByVal hMem As Long) As Long

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" ( _
    ByVal lpDestination As Any, _
    ByVal lpSource As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" ( _
    ByVal lpSource As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Declare Function OpenClipboard Lib "User32" ( _
    ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function SetClipboardData Lib "User32" ( _
    ByVal wFormat As Long, _
    ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "User32" ( _
    ByVal wFormat As Long) As Long

Private Declare Function EnumClipboardFormats Lib "User32" ( _
    ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable _
    Lib "User32" ( _
    ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName _
    Lib "User32" Alias "GetClipboardFormatNameA" ( _
    ByVal wFormat As Long, _
    ByVal lpszformatname As String, _
    ByVal cchMaxCount As Long) As Long

Public Sub Clear()
' Clipboard leeren
    If OpenClipboard(0&) <> 0 Then
        EmptyClipboard
        CloseClipboard
    End If
End Sub

Public Function GetFormat(Optional Format As Long = 1) As Boolean
' Übergabe des gewünschten Clipboard-Formates
' Liefert die True oder False
    If OpenClipboard(0&) <> 0 Then
        GetFormat = IsClipboardFormatAvailable(Format)
        CloseClipboard
    End If
End Function

Public Function EnumFormats(Optional Format As Long = 0) As Long
' Liefert nacheinander die verfügbaren Formate
    If OpenClipboard(0&) <> 0 Then
        EnumFormats = EnumClipboardFormats(Format)
        CloseClipboard
    End If
End Function

Public Function FormatName(Format As Long) As String
' Liefert nacheinander die verfügbaren Formate
    Dim lSize As Long
    If OpenClipboard(0&) <> 0 Then

        FormatName = String$(256, vbNullChar)
        lSize = GetClipboardFormatName(Format, FormatName, 255)
        FormatName = Left(FormatName, lSize)

        CloseClipboard
    End If
End Function

Public Function GetText(Optional Format As Long = 1) As String
' Liefert die Daten aus der Zwischenablage als Text
    Dim hMem As Long
    Dim lpMem As Long
    Dim lSize As Long
    Dim Str As String

    ' Zwischenablage öffnen
    GetText = ""
    If OpenClipboard(0&) = 0 Then
        Err.Raise 521, mModulName, "Zwischenablage kann nicht geöffnet werden."
        Exit Function
    End If

    ' Zugriff auf Speicherblock
    hMem = GetClipboardData(Format)
    If hMem = 0& Then
        CloseClipboard
        Exit Function
    End If

    ' Speicherblock sperren und in Variable übertragen
    lpMem = GlobalLock(hMem)
    If lpMem <> 0 Then
        lSize = lstrlen(lpMem)
        If lSize <> 0 Then
            Str = String$(lSize + 1, vbNullChar)
            lstrcpy Str, lpMem
            GetText = Left$(Str, InStr(1, Str, vbNullChar, vbBinaryCompare) - 1)
        End If
        GlobalUnlock hMem
    End If

    CloseClipboard
End Function

Public Sub SetText(Str As String)
' Stellt die Zeichenkette in der Zwischenablage ab
    Dim hMem As Long
    Dim lpMem As Long

    ' Zwischenablage öffnen
    If OpenClipboard(0&) = 0 Then
        Err.Raise 521, mModulName, "Zwischenablage kann nicht geöffnet werden."
        Exit Sub
    End If

    ' Speicherblock im globalen Heap erstellen
    hMem = GlobalAlloc(GHND, Len(Str) + 1)
    If hMem = 0 Then
        CloseClipboard
        Err.Raise 7, mModulName, "Nicht genügend Speicher."
        Exit Sub
    End If
    lpMem = GlobalLock(hMem)
    lstrcpy lpMem, Str
    GlobalUnlock hMem

    ' Übertragen in die Zwischenablage
    EmptyClipboard
    SetClipboardData CF_TEXT, hMem
    CloseClipboard
End Sub
========================================

En lille funktion til at teste det kunne være:

Sub Test1()
Dim clp As New clipboard, Format As Long, strFormat as String

Selection.Copy ' Kopier den aktuelt valgte tekst
Format = 0
Do ' Gennemløb de formater der er på clipboardet
    Format = clp.EnumFormats(Format)
    strFormat = clp.FormatName(Format)
    If strFormat = "Rich Text Format" Then
        msgBox clp.GetText(Format) ' Vis den herlige rtf-kode
    End If
Loop Until Format = 0
End Sub

Ser lige at der mangler en SetRTF sub i clipboard (læg rtf på clipboard), og jeg kan faktisk ikke finde den jeg tilføjede dengang jeg skulle bruge det.

Men jeg mener den eneste forskel var at jeg ændrede CF_TEXT til CF_RTFTEXT:
Public Sub SetRTF(Str As String)
' Stellt die Zeichenkette in der Zwischenablage ab
    Dim hMem As Long
    Dim lpMem As Long

    ' Zwischenablage öffnen
    If OpenClipboard(0&) = 0 Then
        Err.Raise 521, mModulName, "Zwischenablage kann nicht geöffnet werden."
        Exit Sub
    End If

    ' Speicherblock im globalen Heap erstellen
    hMem = GlobalAlloc(GHND, Len(Str) + 1)
    If hMem = 0 Then
        CloseClipboard
        Err.Raise 7, mModulName, "Nicht genügend Speicher."
        Exit Sub
    End If
    lpMem = GlobalLock(hMem)
    lstrcpy lpMem, Str
    GlobalUnlock hMem

    ' Übertragen in die Zwischenablage
    EmptyClipboard
    SetClipboardData CF_RTFTEXT, hMem
    CloseClipboard
End Sub

Næste trin er så at læse fra database og bagefter gemme i denne.

Det er rimeligt ud af landevejen.
Opret en ado connection, læs via et recordset og skriv via connection.execute

rtf-koden lægges ind i et normalt memo-felt.

Det var ikke helt den rigtige værdi på formatet. Kan også huske det var et eller andet med det. Vil prøve at finde den jeg lavede engang.
Prøv denne:

Public Sub SetRTF(Str As String)
Const CF_RTFTEXT_W2K = 49291
' Stellt die Zeichenkette in der Zwischenablage ab
    Dim hMem As Long
    Dim lpMem As Long

    ' Zwischenablage öffnen
    If OpenClipboard(0&) = 0 Then
        Err.Raise 521, mModulName, "Zwischenablage kann nicht geöffnet werden."
        Exit Sub
    End If

    ' Speicherblock im globalen Heap erstellen
    hMem = GlobalAlloc(GHND, Len(Str) + 1)
    If hMem = 0 Then
        CloseClipboard
        Err.Raise 7, mModulName, "Nicht genügend Speicher."
        Exit Sub
    End If
    lpMem = GlobalLock(hMem)
    lstrcpy lpMem, Str
    GlobalUnlock hMem

    ' Übertragen in die Zwischenablage
    EmptyClipboard
    SetClipboardData CF_RTFTEXT_W2K, hMem
    CloseClipboard
End Sub

Umiddelbart lyder det som en god plan.
Jeg benytter altså clipboardet til at få fat på rtf'en, som dernæst kan gemmes til Access. Når jeg senere ønsker at hente den gemte rtf fra Access, burde jeg så ikke kunne indsætte rtf'en direkte ved f.eks. et bogmærke i Word?

Præcist på den måde.

clp.setRTF(RTFkoden)
Selection.Paste

Det virker fremragende lige bortset fra, at der i setRTF skal stå "Const CF_RTFTEXT_W2K = 49359" istedet for "Const CF_RTFTEXT_W2K = 49291"
Mange tak for hjælpen

Den varierer desværre efter hvilke clipboard formater der eksisterer på den aktuelle computer.

Jeg kan ikke finde den gamle funktion, men den gik ud på at bruge EnumFormats og FormatName til at finde formatet der returnerer "Rich Text Format".
Lidt på samme måde som den lille Test1-sub.