Click here to Skip to main content
15,867,686 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
I have a table with a rich text field. I need to use the CreateReportControl to add this rich text to a report as below

Set txtNew = CreateReportControl(rpt.Name, acTextBox, acDetail, , rs.Fields("Text").Value, Left, Top)

the control has the html for the rich text but it displays on the report as #Error?
So I thought I might need to add the equal sign and enclose the rich text in quotes. like so

Set txtNew = CreateReportControl(rpt.Name, acTextBox, acDetail, , "=" & Chr$(34) & rs.Fields("Text").Value & Chr$(34), Left, Top)

Here is an example of what the field properties for Control source looks like

<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>


The text displays on the screen fine. that markup above it how the recordset formats it. It is not typed by me.
Here is my code:

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





How can this be addressed?

What I have tried:

I looked on google many times and can't find an answer
Posted
Updated 17-Feb-17 15:08pm

1 solution

thanks to help I got from the Microsoft community web site. A person noted that
I had a double-quoted literal inside a double-quoted literal. He suggested the following

You would have to either replace the internal double-quotes with single-quotes (') -- if that would be accepted -- or else replace every internal double-quote with two paired double-quotes. Maybe you would use code like this:
Const Q As String = """"
Const QQ As String = Q & Q
' ... miscellaneous intervening code ...
Set txtNew = CreateReportControl( _
rpt.Name, acTextBox, _
acDetail, _
, _
"=" & Q & _
Replace(rs.Fields("Text").Value, Q, QQ) & _
Q, _
Left, _
Top)

I hope this helps others too
 
Share this answer
 

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900