JohnnyG62 Ответов: 1

Как создать reportcontrol с richtext в access VBA


У меня есть таблица с богатым текстовым полем. Мне нужно использовать CreateReportControl, чтобы добавить этот форматированный текст в отчет, как показано ниже

Set txtNew = CreateReportControl(rpt.Name, acTextBox, acDetail,, rs.Fields("текст").Значение, Слева, Сверху)

элемент управления имеет html-код для форматированного текста, но он отображается в отчете как #Error?
Поэтому я подумал, что мне, возможно, придется добавить знак равенства и заключить богатый текст в кавычки. вот так

Набор txtNew = CreateReportControl(отн.Имя, acTextBox, acDetail, , "=" &амп; помощью chr$(34) &усилителя; РС.Поля("Текст").Значение & Chr$(34), слева, сверху)

Вот пример того, как выглядят свойства поля для источника управления

<div><font face="Times New Roman" size=5 color="#181717">Available in the Documents folder the CD:</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Spare Parts List</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Personal Safety</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Blower/Filter Silencer Documentation</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Controller Equipment Documentation</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Combustion Equipment Documentation</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Hoist and Ladder</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Miscellaneous Equipment</font></div>

<div><font face="Times New Roman" size=5 color="#181717">Refractory Data Sheets</font></div>


Текст отображается на экране нормально. эта разметка над ним показывает, как набор записей форматирует его. Она напечатана не мной.
Вот мой код:

Option Compare Database
Private Sub btnGenerate_Click()

    Dim sql As String
    sql = "SELECT Page, Field, Type, Text, PicPath,Top, Left, Width, Height" & _
           " FROM tblContents ORDER BY Page, Field "
    
    CreateDynamicReport (sql)
end sub

Function CreateDynamicReport(strSQL As String)

On Error GoTo Err:

Dim db As DAO.Database ' database object
Dim rs As DAO.Recordset ' recordset object
Dim fld As DAO.Field ' recordset field
Dim txtNew As Access.TextBox ' textbox control
Dim lblNew As Access.Label ' label control
Dim pbNew As Access.PageBreak ' PageBreak control
Dim atachNew As Access.Attachment ' Attachment control
Dim ImageNew As Access.Image

Dim rpt As Report ' hold report object

Dim title As String 
Dim Page As Integer
Dim fieldType As Integer
Dim Top As Double
Dim Left As Double
Dim Width As Double
Dim Height As Double
Dim pix As Integer
pix = 1440

      
      title = "Title for the Report"

     

      'Create the report
      Set rpt = CreateReport

      ' set properties of the Report
      With rpt
          .Width = 8000 ' 8 inches
          '.RecordSource = strSQL
          .Caption = title
          .PageFooter = False
          .PageHeader = False
      End With


      ' Open SQL query as a recordset
      Set db = CurrentDb
      Set rs = db.OpenRecordset(strSQL)
      rs.MoveFirst


      Page = 1
      ' Create corresponding picture and text box controls for each field.
    
      While Not rs.EOF      
            
            
            If CDbl(rs.Fields("page").Value) <> Page Then 
                Set pbNew = CreateReportControl(rpt.Name, acPageBreak, acDetail, , , 0, 7, 0, 0)
            End If

            Top = CDbl(rs.Fields("Top").Value) * pix
            Left = CDbl(rs.Fields("Left").Value) * pix
            Width = CDbl(rs.Fields("Width").Value) * pix
            Height = CDbl(rs.Fields("Height").Value) * pix
                      
            fieldType = CInt(rs.Fields("Type").Value)
            Select Case (fieldType)
            Case 1: ' text
                
                Set txtNew = CreateReportControl(rpt.Name, acTextBox, acDetail, , "=" & Chr$(34) & rs.Fields("Text").Value & Chr$(34), Left, Top)
                With txtNew
                    .TextFormat = acTextFormatHTMLRichText
                    .Top = Top
                    .Left = Left
                    .Width = Width
                    .Height = Height                    
                    .CanGrow = True
                End With                
            
            Case 2: 'pic                
               
                Set ImageNew = CreateReportControl(rpt.Name, acImage, acDetail, , rs.Fields("PicPath").Value, Left, Top)
                Debug.Print (rs.Fields("PicPath"))
                 With ImageNew
                    .PictureType = 1  'The picture is linked to the object
                    .Top = Top
                    .Left = Left
                    .Width = Width
                    .Height = Height
                    .Visible = True                    
                End With                   

            
            End Select            
            rs.MoveNext
            
       Wend


      
      DoCmd.OpenReport rpt.Name, acViewPreview

      
      
CreateDynamicReport_Exit:
    DoCmd.Hourglass (False)
    rs.Close
    Set rs = Nothing
    Set rpt = Nothing
    Set db = Nothing
Exit Function
    

Err:
    DoCmd.Hourglass (False)
    MsgBox Err.Description, vbExclamation
    'GoTo CreateDynamicReport_Exit
    Resume Next
    
End Function





Как это можно решить?

Что я уже пробовал:

Я много раз заглядывал в гугл и не могу найти ответа

1 Ответов

Рейтинг:
2

JohnnyG62

спасибо за помощь, которую я получил с веб-сайта сообщества Microsoft. Человек отметил, что
У меня появился двойник,-цитирует литерал в двойные кавычки литерал. Он предложил следующее

Вам придется либо заменить внутренние двойные кавычки одинарными кавычками ( ' ) - если это будет принято-либо заменить каждую внутреннюю двойную кавычку двумя парными двойными кавычками. Может быть, вы бы использовали такой код:
Const Q Как Строка = """"
Const QQ As String = Q & Q
- ...разные промежуточные коды ...
Set txtNew = CreateReportControl( _
rpt.Name, acTextBox, _
acDetail, _
, _
"="& Q & _
Заменить(rs.поля("текст").Значение, Q, QQ) & _
Q, _
Слева, _
Верхний)

Я надеюсь, что это поможет и другим