LEADERSOFT.ru Разработка на заказ программ и сайтов
ЕСЛИ БАЗА ВАМ НУЖНА В ЛИДЕРСОФТ ЗАЙДИ СПЕРВА!
Все примеры Microsoft Access - VBA


















































Данный пример показывает как можно редактировать тексты rtf в Microsoft Access.

Все примеры Microsoft Access
'сохранение текущей записи в файле в формате RTF
Private Sub cmdSave_Click()
    Me.RichTextBox1.SaveFile CurrentProject.Path & "\rtftemp" & Me.ID & ".rtf"
End Sub


'сохранение всех записей в файле в формате RTF
Private Sub cmdSaveAll_Click()
Dim As Long, p As Long
Dim strtemp As String, strrtf As String
    'разделитель записей (по желанию)
    Const spl = "\rtf1\ansi\ansicpg1251\deff0\deflang1049{\fonttbl{\f0\fnil\fcharset0 Tahoma;}}" & _
    "\viewkind4\uc1\pard\f0\fs24 ************************************" & _
    "\par"
    
    'сведем все записи воедино
    DoCmd.GoToRecord , , acFirst
    DoCmd.Echo False
    For i = 1 To DCount("[ID]""T1")
         strtemp = Me.RichTextBox1.TextRTF
         'для "нормального" склеивания фрагментов текста надо удалить лишние "}" "{"
         p = InStrRev(strtemp, "}")
         strtemp = Left(strtemp, p - 1)
         p = InStr(strtemp, "{")
         strtemp = Right(strtemp, Len(strtemp) - p)
         strrtf = strrtf & strtemp & spl
         DoCmd.GoToRecord , , acNext
    Next i
    DoCmd.GoToRecord , , acFirst
    DoCmd.Echo True
    
    'восстановим начальные и конечные "{"
    strrtf = "{" & strrtf & "}"
    
    'чтобы полученный не влиял на данные, отключим RichTextBox от данных
    strtemp = Me.RichTextBox1.ControlSource
    Me.RichTextBox1.ControlSource = ""
    Me.RichTextBox1.TextRTF = strrtf
    
    Me.RichTextBox1.SaveFile CurrentProject.Path & "\rtftempall.rtf"
    
    'восстановим нормальную работу
    Me.RichTextBox1.ControlSource = strtemp
End Sub


'управление насыщенностью
Private Sub ctlBold_AfterUpdate()
    Select Case Me.ctlBold.Value
    Case -1
    Me.RichTextBox1.SelBold = True
    Case 0
    Me.RichTextBox1.SelBold = False
    End Select
    Me.RichTextBox1.SetFocus
End Sub