from table to a template (1 Viewer)

[adaniele]

hi, guys, it has been a long time without solving this problem by myself. Perhaps you can hlp me.

I need to send info to a word doc. That's easy.
The complexity comes because it's like a receipt. I need to send info from the receipts, which is always there and details from the receipts, which is not always the same.

For instance: i sold 3 wines, so the body of the doc will have 3 lines. but, if i sold 24 wines it will have 24 lines.

I have the receipt data in a table and the details in another table.

How can i make a dynamic word doc, that increase it's lines depending on the details table?

thx, max.

 

[Sergeant]

What method are you using to transfer the data to the word template?

 

[adaniele]

What method are you using to transfer the data to the word template?

i am not using bookmarks. i am just adding the fields next to the title of the field.

thx, max.

 

[Sergeant]

i am not using bookmarks. i am just adding the fields next to the title of the field.

thx, max.

I'm sorry, you need to elaborate a bit more.

 

[adaniele]

I'm sorry, you need to elaborate a bit more.

Here is the code that i use to create a merged doc ...

  'Create a Word instance
        Set appWord = CreateObject("Word.Application")
        appWord.Visible = False
        
        Dim dtMyDate, MyStr
        dtMyDate = Date
        MyStr = Format(dtMyDate, "ddmmyyyy")
        
        'Open the selected merge document
        strWordDoc = "W:\Documents and Settings\mdaniel\Application Data\Microsoft\Templates\2.dot"
        appWord.Documents.Open strWordDoc
        strFileName = "s:\wine\pops\IFSGW" & Me.ifsnumber.Value & "_Item" & Me.winecode.Value & "_" & MyStr & ".doc"
        
        'Set the merge data source to the SQL statement, and do the merge
        strDBName = "S:\qf_space\wine\wine.mdb"
        strSQL = "select tempmergeaddpop.* from tempmergeaddpop;"
       
       With appWord
          .ActiveDocument.MailMerge.OpenDataSource Name:=strDBName, _
             LinkToSource:=True, SQLStatement:=strSQL
          .ActiveDocument.MailMerge.Destination = wdSendToNewDocument
          .ActiveDocument.MailMerge.Execute
          .Documents(strWordDoc).Close savechanges:=wddonotsavechanges
          .ActiveDocument.SaveAs FileName:=strFileName, FileFormat:=wdFormatDocument
          .ActiveDocument.Close savechanges:=wddonotsavechanges
          '.ActiveDocument.PrintOut
          .Quit
       End With

To create the template i saved a doc as dot. Then i use the merge feature to put the fields from the table (used in the code avobe) in the template.

I hope this hlp you to hlp me.
thx, max.

 

[Sergeant]

OK, so you're using Mail Merge. Does this currently give you one doc per record? Or does it put the whole query on one doc?

The other obvious question is...could you do this with a report, exported in *.rtf format?

 

[adaniele]

OK, so you're using Mail Merge. Does this currently give you one doc per record? Or does it put the whole query on one doc?

The other obvious question is...could you do this with a report, exported in *.rtf format?

sergeant, the previous code was an example of how i am using the mail merge.
I am trying to use the same method for this new form but i dont know how to do, because i need to send to the word doc, 1 record from one table and one or more records from another table.

ex. If i sold 3 wines, i would have to send:
1 record from receipt table and 3 records from wine table.

thx, again , Max.

 

[Sergeant]

So, to ask the question again...
Can you do this with a report, or MUST you have a word doc?

I would be leaning toward a report in Access.

 

[Pat Hartman]

I would suggest using bookmarks in your template. Then creating tables which you place at the bookmark. Here's some code from an application I created that does this. It created specification documents that included multiple "sub reports".

Public Sub FinishTable(bkmk As String, strTable As String)
    
    On Error GoTo PROC_ERR
    
    InsertTextAtBookMark bkmk, strTable
    Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
    objTable.AutoFormat Format:=wdTableFormatProfessional, applyshading:=True, applyHeadingrows:=True, AutoFit:=True
    '        objTable.Rows(1).HeadingFormat = True
    WordApp.Selection.MoveRight Unit:=wdCell
    WordApp.Selection.Rows.HeadingFormat = wdToggle
    Call SetShading
    Set objTable = Nothing
    
PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT
    
End Sub

Public Sub SetShading()
    '   WordApp.Selection.MoveRight Unit:=wdCell
    On Error GoTo Error_SetShading
    WordApp.Selection.SelectRow
    With WordApp.Selection.Cells
        With .Shading
            .Texture = wdTextureSolid
            .ForegroundPatternColor = wdColorPlum
            .BackgroundPatternColor = wdColorWhite
        End With
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
'    With Options
'        .DefaultBorderLineStyle = wdLineStyleSingle
'        .DefaultBorderLineWidth = wdLineWidth075pt
'        .DefaultBorderColor = wdColorAutomatic
'    End With
    With WordApp.Selection.Font
        .Name = "Arial"
        .Size = 10
        .Bold = True
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .Strikethrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = True
        .AllCaps = False
        .Color = wdColorWhite
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
    End With
Exit_SetShading:
    Exit Sub
Error_SetShading:
    Select Case Err.Number
        Case 5843   ' out of range
            Resume Next
        Case 462   ' remote server does not exist
            Resume Next
        Case Else
            MsgBox Err.Number & "-" & Err.Description
            Resume Exit_SetShading
    End Select
End Sub
Public Sub InsertTextAtBookMark(strBkmk As String, varText As Variant)
    
    On Error GoTo PROC_ERR
    
    WordDoc.Bookmarks(strBkmk).Select
    WordApp.Selection.Text = varText & ""
    
PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT
    
End Sub

Here's code that builds the "table" that the above code needs:

Public Function AirCycleMachinePerformanceReq()
    
    On Error GoTo PROC_ERR
    
    Set rs = Application.CurrentProject.Connection.Execute("SELECT * FROM AirCycleMachinePerformanceReq WHERE ModelNumber = '" & strModel & "' AND ItemNumber = '" & strItem & "'")
    'Loop through Items & fill table with detail
    If rs.EOF Then
        strTable = "AirCycleMachinePerformanceReq data MISSING" & vbCr
    Else
        strTable = "Comp" & vbTab & "Design Cond" & vbTab & "Flow Rate" & vbTab & "In Temp" & vbTab & "Out Temp" & vbTab & "Free moisture" & vbTab
        strTable = strTable & "In Press (psia)" & vbTab & "Out Press" & vbTab & "Diffuser Count" & vbTab & "Difuser Def" & vbTab & "Wheel Dia" & vbTab
        strTable = strTable & "Overall Eff %" & vbTab & "Surge Margin" & vbTab & "Abs Humidity" & vbCr
        Do Until rs.EOF
            strTable = strTable & rs!Component & vbTab
            strTable = strTable & rs!DesignConditions & vbTab
            strTable = strTable & rs!FlowRate & vbTab
            strTable = strTable & rs!InletTemperature & vbTab
            strTable = strTable & rs!OutletTemperature & vbTab
            strTable = strTable & rs!FreeMoisture & vbTab
            
            strTable = strTable & rs!InletPressure & vbTab
            strTable = strTable & rs!OutletPressure & vbTab
            strTable = strTable & rs!DiffuserCount & vbTab
            strTable = strTable & rs!DiffuserDefinition & vbTab
            strTable = strTable & rs!WheelDiameters & vbTab
            
            strTable = strTable & rs!OverallEfficiencyPct & vbTab
            strTable = strTable & rs!SurgeMargin & vbTab
            strTable = strTable & rs!AbsoluteHumidity & vbCr
            
            rs.MoveNext
        Loop
        
    End If
    Call FinishTable("AirCycleMachinePerformanceReq", strTable)
    
PROC_EXIT:
    Exit Function
    
PROC_ERR:
    MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT
    
End Function

 

[adaniele]

I would suggest using bookmarks in your template. Then creating tables which you place at the bookmark. Here's some code from an application I created that does this. It created specification documents that included multiple "sub reports".

Public Sub FinishTable(bkmk As String, strTable As String)
    
    On Error GoTo PROC_ERR
    
    InsertTextAtBookMark bkmk, strTable
    Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
    objTable.AutoFormat Format:=wdTableFormatProfessional, applyshading:=True, applyHeadingrows:=True, AutoFit:=True
    '        objTable.Rows(1).HeadingFormat = True
    WordApp.Selection.MoveRight Unit:=wdCell
    WordApp.Selection.Rows.HeadingFormat = wdToggle
    Call SetShading
    Set objTable = Nothing
    
PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT
    
End Sub

Public Sub SetShading()
    '   WordApp.Selection.MoveRight Unit:=wdCell
    On Error GoTo Error_SetShading
    WordApp.Selection.SelectRow
    With WordApp.Selection.Cells
        With .Shading
            .Texture = wdTextureSolid
            .ForegroundPatternColor = wdColorPlum
            .BackgroundPatternColor = wdColorWhite
        End With
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
            .Color = wdColorBlack
        End With
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
'    With Options
'        .DefaultBorderLineStyle = wdLineStyleSingle
'        .DefaultBorderLineWidth = wdLineWidth075pt
'        .DefaultBorderColor = wdColorAutomatic
'    End With
    With WordApp.Selection.Font
        .Name = "Arial"
        .Size = 10
        .Bold = True
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .Strikethrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = True
        .AllCaps = False
        .Color = wdColorWhite
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
    End With
Exit_SetShading:
    Exit Sub
Error_SetShading:
    Select Case Err.Number
        Case 5843   ' out of range
            Resume Next
        Case 462   ' remote server does not exist
            Resume Next
        Case Else
            MsgBox Err.Number & "-" & Err.Description
            Resume Exit_SetShading
    End Select
End Sub
Public Sub InsertTextAtBookMark(strBkmk As String, varText As Variant)
    
    On Error GoTo PROC_ERR
    
    WordDoc.Bookmarks(strBkmk).Select
    WordApp.Selection.Text = varText & ""
    
PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT
    
End Sub

Here's code that builds the "table" that the above code needs:

Public Function AirCycleMachinePerformanceReq()
    
    On Error GoTo PROC_ERR
    
    Set rs = Application.CurrentProject.Connection.Execute("SELECT * FROM AirCycleMachinePerformanceReq WHERE ModelNumber = '" & strModel & "' AND ItemNumber = '" & strItem & "'")
    'Loop through Items & fill table with detail
    If rs.EOF Then
        strTable = "AirCycleMachinePerformanceReq data MISSING" & vbCr
    Else
        strTable = "Comp" & vbTab & "Design Cond" & vbTab & "Flow Rate" & vbTab & "In Temp" & vbTab & "Out Temp" & vbTab & "Free moisture" & vbTab
        strTable = strTable & "In Press (psia)" & vbTab & "Out Press" & vbTab & "Diffuser Count" & vbTab & "Difuser Def" & vbTab & "Wheel Dia" & vbTab
        strTable = strTable & "Overall Eff %" & vbTab & "Surge Margin" & vbTab & "Abs Humidity" & vbCr
        Do Until rs.EOF
            strTable = strTable & rs!Component & vbTab
            strTable = strTable & rs!DesignConditions & vbTab
            strTable = strTable & rs!FlowRate & vbTab
            strTable = strTable & rs!InletTemperature & vbTab
            strTable = strTable & rs!OutletTemperature & vbTab
            strTable = strTable & rs!FreeMoisture & vbTab
            
            strTable = strTable & rs!InletPressure & vbTab
            strTable = strTable & rs!OutletPressure & vbTab
            strTable = strTable & rs!DiffuserCount & vbTab
            strTable = strTable & rs!DiffuserDefinition & vbTab
            strTable = strTable & rs!WheelDiameters & vbTab
            
            strTable = strTable & rs!OverallEfficiencyPct & vbTab
            strTable = strTable & rs!SurgeMargin & vbTab
            strTable = strTable & rs!AbsoluteHumidity & vbCr
            
            rs.MoveNext
        Loop
        
    End If
    Call FinishTable("AirCycleMachinePerformanceReq", strTable)
    
PROC_EXIT:
    Exit Function
    
PROC_ERR:
    MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT
    
End Function

Pat, thx for your hlp.

I am trying with a report. I created a report and then tryed to send it to word. The only problem with this option is that only the text is transfered, the lines do not appear in the word doc.

anyway, here is the doc that i need to fill as an output. I think that looking at this form i could explain better what i need.

thx

 

[adaniele]

here is the form
thx, max.