PDA

View Full Version : [SOLVED:] Dynamically create report based on (varing number of) Queries, then output to Word



OTWarrior
01-12-2017, 08:23 AM
I am trying to build a reporting tool, that will allow the user to create a number of queries (from an imported spreadsheet).

The number of and values of these queries will be different, so I can't hard code much. It all has to be dynamic.

I am at the point where I can generate the queries easily enough, but the issue is how to present them in a suitable format.

I could export them one at a time to different reports, but it needs to be in a word document format (so the built in RTF exporter won't work).

I'll be exporting the queries directly, as well as strings, so it will need to be able to export the queries directly into Word. I have the following code so far

For creating a report:


Function CreateReports()
Dim rpt As Report
Dim ctl As Control
Dim x As Integer
Dim nTop As Long
Dim nPOS As Long
Dim i As Integer
' Create the parent report
Set rpt = CreateReport
'ListDbQrys
' Add the subreport controls
x = 1
nTop = 50
If Qcount = 0 Then Qcount = lblQcount.Caption
'Set rpt.Height = 500 * Qcount
For x = 1 To Qcount

nPOS = DCount("*", QueryArray(x))

Set ctl = CreateReportControl(rpt.Name, acSubform, acDetail, rpt.Name, x, 15, nTop, 5000, nPOS * 15)
' set subreport properties here
ctl.SourceObject = "Query." & QueryArray(x) 'sets source report to the current query in the loop
ctl.StatusBarText = Chr(34) & ctl.SourceObject & Chr(34)

'try to resize the columns of each subreport query
' Dim qdf1 As DAO.QueryDef
' Dim fld1 As DAO.Field
'
' Set qdf1 = CurrentDb.QueryDefs(QueryArray(x))
'
' For i = 0 To qdf1.Fields.Count - 1
' Set fld1 = qdf1.Fields(i)
' fld1.CreateProperty "ColumnWidth", dbInteger
' Set fld1 = Nothing
' Next i


'If nPOS < 4 Then nPOS = nPOS + 4
nTop = nTop + (x * 500)
Next

DoEvents
DoCmd.OpenReport rpt.Name, acViewPreview, , , acDialog
'this will restore the report, which is currently minimized in design view.
'DoCmd.OpenReport rpt
Set ctl = Nothing
Set rpt = Nothing
End Function


Whereas this is what I have to export to Word:
(This doesn't like the SQL queries in the "Qtable" section, it throws an error)


Function FindBMark(txtQuery As String)
Dim WordObj As Word.Application
Dim cnxn As ADODB.Connection
Dim rL As ADODB.Recordset
Set cnxn = CurrentProject.Connection
Set rL = New ADODB.Recordset
On Error GoTo err_handle

' Start Microsoft Word and open the document.
Set WordObj = CreateObject("Word.Application")
WordObj.Documents.Open "Y:\Report Template - Test.docx" 'to be made dynamic
With WordObj.ActiveDocument
'.Bookmarks("qtitle").Select
.Bookmarks("qtitle").Range.Text = txtQuery

'add qrytable info to document
'.Bookmarks("qtable").Range.Fields(1).Result.Text = txtQuery
rL.Open txtQuery, cnxn, adOpenForwardOnly, adLockReadOnly, acQuery

If Not rL.EOF Then .Bookmarks("qtable").Range.Fields(1).Result.Text = rL.Fields(txtQuery)
'.Bookmarks("qtable").Select
.Bookmarks("qtable").Range.Fields(1).Result.Text = rL.Fields(txtQuery)

'.Bookmarks("qtotal").Select
.Bookmarks("qtotal").Range.Text = DSum("Mentions", txtQuery) & " Comments"
rL.Close
End With
'Close and save the document.
WordObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
'WordObj.ActiveDocument.Save
' Quit Microsoft Word and release the object variable.
WordObj.Quit
If MsgBox("Task Completed" & vbCrLf & vbCrLf & "Do you want to open the file?", vbYesNo) = vbYes Then _
WordObj.Documents.Open "Y:\Report Template - Test.docx"
Set WordObj = Nothing
Exit Function
err_handle:
MsgBox Err.Number & "-" & Err.Description
WordObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
WordObj.Quit
End Function



Anyone know of a better way of achieving this please?

OTWarrior
01-19-2017, 02:51 AM
If anyone wants to do this in future, you need to set a bookmark for the whole table in word (for each table you want to edit)


Set oTable = .Bookmarks("qtable" & i).Range.Tables(1)


If rL.RecordCount + 1 >= oTable.Rows.Count Then
'Append a row to the Word table
oTable.Rows.Add
End If

'For rowNum = 1 To oTable.Rows.Count - 1
' oTable.Rows(rowNum).Delete
'Next rowNum

oTable.Cell(1, 1).Range.Text = "Question" ' table header field 1
oTable.Cell(1, 2).Range.Text = "Count" ' table header field 2

Do While Not rL.EOF
If rL.RecordCount > oTable.Rows.Count Then
'Append a row to the Word table
oTable.Rows.Add
End If

oTable.Cell(Position, 1).Range.Text = rL.Fields(0)
oTable.Cell(Position, 1).Range.Font.Name = "Calibri (Body)" ' Set the font
oTable.Cell(Position, 1).Range.Font.Size = 11 ' set the font size

oTable.Cell(Position, 2).Range.Text = rL.Fields(1)
oTable.Cell(Position, 2).Range.Font.Name = "Calibri (Body)"
oTable.Cell(Position, 2).Range.Font.Size = 11

Position = Position + 1
rL.MoveNext

Loop


If you know the maximum number of tables you need, you can set this value in an if loop around this, so when you exceed the number of tables you need, you can then delete them (Note, the bookmark "pb" & number is the page break, in case you have them. Again, you'll need to set bookmarks for them).


Set oTable = .Bookmarks("qtable" & i).Range.Tables(1)

oTable.Delete
.Bookmarks("qtitle" & i).Range.Delete
.Bookmarks("qtotal" & i).Range.Delete
Select Case i
Case 2, 4, 6, 8, 10
.Bookmarks("pb" & (i / 2)).Range.Delete
End Select


One important note for setting bookmarks, make sure you highlight the text you need only. Word has a tendency to also include the space after the word highlighted, which will throw off your formatting.