Display the answer of each question in word document from Access form

D

Derek

Registered User.
Local time
Today, 04:59
Joined
May 4, 2010
Messages
234
Hi All

I have designed a Health check form in Access and data gets saved in tables. I have designed a continuous sub form for all the questions and result gets stored in table tblTC . Its working perfectly fine.

But now I need to display the result in Word template and the users might print it off later or save it in shared folder. I can't get my head around how to do it? Please see attached the word document. I need to populate the result of each question that is being input in the Access form to the word document. So answer of each question will be Yes, No or N/A.

Any help will be much appreciated.

Thanks
 

Attachments

Hello Uncle Gizmo

I want to get this done using VBA. So basically when the button is clicked then populate answer to each question (Yes, No or N/A) in word document and print it off.

Thanks
 
I'm not sure as I don't have much experience with this. The approach I would adopt would be to send everything to the word document as one whole table. Finding the check boxes in the word document and updating them might well be possible, but I think it would be difficult.

Sent from my SM-G925F using Tapatalk
 
Word doesn't know anything about data, so you can't ask it meaningful questions easily.

You might want to set the value of a checkbox but which one is it? At the point you write the code it might be the 4th one down and 2nd accross, but will that still be the case in 6 months time?
One slight change to the template forces you to change your code. So I'd suggest automating the entire thing from Access.

This won't match your table but it might give you ideas.

tblTC : fields
QID - question ID
Q - question
A - answer

QID is the format
1.1.1
1.1.2
1.1.3
...etc...
2.1.1
2.1.2
2.1.3
...etc...

Where the first number is the section ID
I split the ID off and look the title up in the code but you'd get it from the query.

Code: 
Private Sub Command0_Click()
    Dim CurSec() As String, PrevSec As String
    
    With CurrentDb.OpenRecordset("select * from tblTC order by QID")

        If .BOF And .EOF Then Exit Sub

        Dim wd As New Word.Document
        With wd.Parent
            .Visible = True
            .Activate
            .ScreenUpdating = False
        End With
        
        Dim wt As Word.Table, wr As Word.Row
        Set wt = wd.Tables.Add(wd.Parent.Selection.Range, 1, 3)
        wt.Columns(1).Width = 40
        wt.Columns(2).Width = 400
        wt.Columns(3).Width = 90
        
        RowFormat wt.Range, False
        
        Do Until .EOF
            CurSec = Split(.Fields(0), ".")

            Set wr = wt.Rows.Add
            wr.Cells(1).Range.Text = CurSec(1) & "." & CurSec(2)
            wr.Cells(2).Range.Text = .Fields(1)
            wr.Cells(3).Range.Text = .Fields(2)

            
            If Not CurSec(0) = PrevSec Then
                'new section, create a header
                
                PrevSec = CurSec(0)
                Set wr = wt.Rows.Add(wr)
                wr.Cells(1).Range.Text = SecName(CurSec(0))
                wr.Cells(3).Range.Text = "Response"
                wd.Range(wr.Cells(1).Range.Start, wr.Cells(2).Range.End).Cells.Merge
                RowFormat wr.Range, True
            End If
            
            .MoveNext
        Loop
        wt.Rows(1).Delete
    End With
    
    With wd.Parent
        .ScreenUpdating = True
    End With
        
    
End Sub

Private Function SecName(id) As String
    Select Case id
    Case 1: SecName = "T&C Activity and File Checks"
    Case 2: SecName = "Clear Desk"
    Case 3: SecName = "Material Review (e.g. Scripts, Criteria, PK Sheets)"
    End Select
End Function

Private Sub RowFormat(r As Word.Range, IsHeader As Boolean)
    
    If IsHeader Then
        r.Shading.BackgroundPatternColor = -738132071
    Else
        Dim c As Word.Cell
        For Each c In r.Cells
            AddBorders c.Range
        Next

    End If

End Sub

Private Sub AddBorders(r As Word.Range)
    For i = -4 To -1
        r.Borders(i).LineStyle = Options.DefaultBorderLineStyle
    Next
End Sub
 
Another approach? could you design the report in access to look like the word doc and then save as pdf? If has to be in word, then that probably won't work.
 
Thanks Static, As I have already designed the word document with appropriate header and footer and Title etc... Can we insert the table automatically after the Title and Objective section as attached?
 

Attachments

You could add a bookmark, open the file replace the bookmark with the table.


Code: 
Private Sub Command0_Click()
    Dim CurSec() As String, PrevSec As String
    
    With CurrentDb.OpenRecordset("select * from tblTC order by QID")

        If .BOF And .EOF Then Exit Sub
        
        Dim wa As New Word.Application
        Dim wd As Word.Document
        Dim bk As Word.Bookmark
        
        With wa
            .Visible = True
            .Activate
            .ScreenUpdating = False
        End With
        
        Set wd = wa.Documents.Open("c:\Health Check Form.doc")
        
        Set bk = wd.Bookmarks("InsertTable")
        
        Dim wt As Word.Table, wr As Word.Row
        'Set wt = wd.Tables.Add(wd.Parent.Selection.Range, 1, 3)
        Set wt = wd.Tables.Add(bk.Range, 1, 3)
 
Thanks Static, Just have spoken to my manager and he said it will be nice if I display 3 sections 1. Passed 2. Failed 3. N/A

so in the Passed section, all the questions will appear whose answer is Yes.
in the Failed section, all those questions will appear whose answer is No
in the N/A section , those questions whose answer is N/A will appear in the word document.

Can this be done? if yes then can you pls help me in this?

Thanks
 
Sure it can be done. Here you go.

Code: 
Private Sub Command0_Click()
    Dim CurSec() As String, PrevSec As String
    
    With CurrentDb.OpenRecordset("select * from tblTC order by QID")

        If .BOF And .EOF Then Exit Sub
        
        Dim wa As New Word.Application
        Dim wd As Word.Document
        Dim bk As Word.Bookmark
        
        With wa
            .Visible = True
            .Activate
            .ScreenUpdating = False
        End With
        
        Set wd = wa.Documents.Open("c:\Health Check Form.doc")
        
        Set bk = wd.Bookmarks("InsertTable")
        
        Dim wt As Word.Table, wr As Word.Row
        Set wt = wd.Tables.Add(bk.Range, 1, 5)
        
        wt.Columns(1).Width = 40
        wt.Columns(2).Width = 400
        wt.Columns(3).Width = 30
        wt.Columns(4).Width = 30
        wt.Columns(5).Width = 30
        
        RowFormat wt.Range, False
        
        Do Until .EOF
            CurSec = Split(.Fields(0), ".")

            Set wr = wt.Rows.Add
            wr.Cells(1).Range.Text = CurSec(1) & "." & CurSec(2)
            wr.Cells(2).Range.Text = .Fields(1)
            
            Select Case Trim(LCase(.Fields(2)))
            Case "yes": wr.Cells(3).Range.Text = "X"
            Case "no": wr.Cells(4).Range.Text = "X"
            Case Else: wr.Cells(5).Range.Text = "X"
            End Select
            
            If Not CurSec(0) = PrevSec Then
                'new section, create a header
                
                PrevSec = CurSec(0)
                Set wr = wt.Rows.Add(wr)
                wr.Cells(1).Range.Text = SecName(CurSec(0))
                wr.Cells(3).Range.Text = "Yes"
                wr.Cells(4).Range.Text = "No"
                wr.Cells(5).Range.Text = "N/A"
                wd.Range(wr.Cells(1).Range.Start, wr.Cells(2).Range.End).Cells.Merge
                RowFormat wr.Range, True
            End If
            
            .MoveNext
        Loop
        wt.Rows(1).Delete
    End With
    
    With wd.Parent
        .ScreenUpdating = True
    End With
        
    
End Sub
 
Hi Static, The code is giving me compile error "Sub or function not defined" at Rowformat line. :(

Can you pls help me in this? Thanks
 
I only reposted the procedure that needed changing. You still need the other three.
 
Hi Static, I tried the code and I'm getting runtime error 5992, Cannot access individuals columns in this collection because the table has mixed cell widths at the following:
Code: 
 wt.Columns(1).Width = 40
        wt.Columns(2).Width = 400
        wt.Columns(3).Width = 30
        wt.Columns(4).Width = 30
        wt.Columns(5).Width = 30

That's my amended code:
Code: 
 Private Sub cmdSummit_Click()
    
    Dim CurSec() As String, PrevSec As String
    
    With CurrentDb.OpenRecordset("select * from qryQAMatrix where QAID=" & txtQAID & "")
  
         If .BOF And .EOF Then Exit Sub
        
        Dim wa As New Word.Application
        Dim wd As Word.Document
        Dim bk As Word.Bookmark
        
        With wa
            .Visible = True
            .Activate
            .ScreenUpdating = False
        End With
        
        Set wd = wa.Documents.Open("L:\Access Databases\Group Manufacturing\Mortgages Direct\Academy\ADFE\Files\T&C Templates\QA Forms\Health Check Form.doc")
        
        Set bk = wd.Bookmarks("InsertTable")
        
        Dim wt As Word.Table, wr As Word.Row
        Set wt = wd.Tables.Add(bk.Range, 1, 5)
        
'       wt.Columns(1).Width = 40
        wt.Columns(2).Width = 400
        wt.Columns(3).Width = 30
        wt.Columns(4).Width = 30
        wt.Columns(5).Width = 30
        
        RowFormat wt.Range, False
        
        Do Until .EOF
            CurSec = Split(.Fields(0), ".")
             Set wr = wt.Rows.Add
'            wr.Cells(1).Range.Text = CurSec(1) & "." & CurSec(2)
            wr.Cells(2).Range.Text = .Fields(1)
            
            Select Case Trim(LCase(.Fields(2)))
            Case "yes": wr.Cells(3).Range.Text = "X"
            Case "no": wr.Cells(4).Range.Text = "X"
            Case Else: wr.Cells(5).Range.Text = "X"
            End Select
            
            If Not CurSec(0) = PrevSec Then
                'new section, create a header
                
                PrevSec = CurSec(0)
                Set wr = wt.Rows.Add(wr)
                wr.Cells(1).Range.Text = SecName(CurSec(0))
                wr.Cells(3).Range.Text = "Yes"
                wr.Cells(4).Range.Text = "No"
                wr.Cells(5).Range.Text = "N/A"
                wd.Range(wr.Cells(1).Range.Start, wr.Cells(2).Range.End).Cells.Merge
                RowFormat wr.Range, True
            End If
            
            .MoveNext
        Loop
        wt.Rows(1).Delete
    End With
    
    With wd.Parent
        .ScreenUpdating = True
    End With
        
    
End Sub
 
And also just wondering Can we have just one column for score instead of 3 separate columns (Yes,No,N/A)?
 
Static, I am getting "Runtime error 9 Subscript out of range" in the following line:
Code: 
 wr.Cells(1).Range.Text = CurSec(1) & "." & CurSec(2)

The following is the complete code:
Code: 
 Private Sub cmdSummit_Click()
    Dim CurSec() As String, PrevSec As String
    
    With CurrentDb.OpenRecordset("select refid,standarddoc,score from qryQAMatrix where QAID=" & txtQAID & "")
         If .BOF And .EOF Then Exit Sub
        
        Dim wa As New Word.Application
        Dim wd As Word.Document
        Dim bk As Word.Bookmark
        
        With wa
            .Visible = True
            .Activate
            .ScreenUpdating = False
        End With
        
        Set wd = wa.Documents.Open("L:\Health Check Form.doc")
        
        Set bk = wd.Bookmarks("InsertTable")
        
        Dim wt As Word.Table, wr As Word.Row
        Set wt = wd.Tables.Add(wd.Parent.Selection.Range, 1, 3)
       ' Set wt = wd.Tables.Add(bk.Range, 1, 3)
        wt.Columns(1).Width = 40
        wt.Columns(2).Width = 400
        wt.Columns(3).Width = 90
        
        RowFormat wt.Range, False
        
        Do Until .EOF
            CurSec = Split(.Fields(0), ".")
             Set wr = wt.Rows.Add
            wr.Cells(1).Range.Text = CurSec(1) & "." & CurSec(2)
            wr.Cells(2).Range.Text = .Fields(1)
            wr.Cells(3).Range.Text = .Fields(2)
             
            If Not CurSec(0) = PrevSec Then
                'new section, create a header
                
                PrevSec = CurSec(0)
                Set wr = wt.Rows.Add(wr)
                wr.Cells(1).Range.Text = SecName(CurSec(0))
                wr.Cells(3).Range.Text = "Response"
                wd.Range(wr.Cells(1).Range.Start, wr.Cells(2).Range.End).Cells.Merge
                RowFormat wr.Range, True
            End If
            
            .MoveNext
        Loop
        wt.Rows(1).Delete
    End With
    
    With wd.Parent
        .ScreenUpdating = True
    End With
End Sub
 
I got 3 fields in the query named "RefID","Standard Docs" and "Score".

RefID has Text datatype
StandardDocs has Text datatype
Score has number datatype
 
Is this a wind up?

I know what fields you have. I can see them in your code.

The question was, what format is refID? What does the data look like?
 
You must log in or register to reply here.

Similar threads

C
download invoice documents from Amazon - possible?
Replies
7
Views
371
CJ_London
C
S
Solved Only the Document, not the Path
2
Replies
31
Views
763
Pat Hartman
P
G
How to display a Word document in Access
Replies
14
Views
1,487
Pat Hartman
P
C
Embedding a linked document in a report
Replies
7
Views
860
isladogs
isladogs
T
Table Displayed in Text Box?
Replies
7
Views
507
TheSearcher
T

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom