View Single Post
 
Old 06-04-2013, 05:38 AM
DepricatedZero DepricatedZero is offline Windows 8 Office 2007
Novice
 
Join Date: Jun 2013
Posts: 6
DepricatedZero is on a distinguished road
Default Tables not populating properly from code

The below module works to create a tabled header on each page and a new page for each customer in my Access DB that this is being run from.

I've included the full code so you can see everything that's happening (Every sub gets called)

As it is, this code fills the tables properly. However, if I add anything at any point prior to the first time CreateHeader gets called, rows 2 and 3 of my tables are not filled.

Can anyone see where I'm going wrong here? I want to create a blank table on the first page, then the headers, then create a TableOfContents in the blank table.

Also, my Delimit function doesn't seem to be running at all. The intent is to use Heading 1 and Heading 2 to automatically build out a Table of Contents from headings.

Code:
Option Explicit
Public Function Test()
    BuildCustomerDetailReport
End Function
Public Sub BuildCustomerDetailReport()
    
    Dim wordApp As Word.Application
    Dim wordDoc As Word.Document
    
    
    
    Set wordApp = New Word.Application
    Set wordDoc = wordApp.Documents.Add()
    
    SetLayout wordDoc, wordApp
    
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim def As DAO.QueryDef
    
    Set db = CurrentDb
    Set def = db.QueryDefs![qryReport_CustomerDetails_PARAM]
    
    def.Parameters![tier] = "Platinum"
    
    Set rs = def.OpenRecordset
    
    rs.MoveFirst
    
    Delimit wordDoc, rs
    
    Do Until rs.EOF
        CreateHeader wordDoc, rs
        
        rs.MoveNext
    Loop
    
    wordDoc.Tables.Add wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range, 1, 1
    wordDoc.TablesOfContents.Add wordDoc.Tables(wordDoc.Tables.Count).Cell(1, 1).Range, True
    
    wordApp.Visible = True
    
    Set wordApp = Nothing
    
End Sub
Private Sub Delimit(wordDoc As Word.Document, rs As DAO.Recordset)
    'this isn't even getting run somehow
    wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.text = rs!strTier
    wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.Style = wordDoc.Styles("Heading 1")
End Sub
Private Sub SetLayout(wordDoc As Word.Document, wordApp As Word.Application)
    With wordDoc.Paragraphs.TabStops
        .ClearAll
        .Add Position:=InchesToPoints(0.75), Alignment:=wdAlignTabRight
        .Add Position:=InchesToPoints(0.8), Alignment:=wdAlignTabLeft
        .Add Position:=InchesToPoints(4.5), Alignment:=wdAlignTabRight
        .Add Position:=InchesToPoints(4.55), Alignment:=wdAlignTabLeft
    End With
    wordDoc.Paragraphs.LineSpacingRule = wdLineSpaceExactly
    wordDoc.Paragraphs.LineSpacing = 10
    With wordDoc.PageSetup
        .TopMargin = wordApp.InchesToPoints(0.2)
        .BottomMargin = wordApp.InchesToPoints(0.5)
        .LeftMargin = wordApp.InchesToPoints(0.5)
        .RightMargin = wordApp.InchesToPoints(0.5)
    End With
    With wordDoc.Styles("Heading 2").Font
        .Bold = True
        .Size = 14
        .name = "Calibri"
        .Color = wdColorBlack
    End With
    With wordDoc.Styles("Heading 1").Font
        .Bold = False
        .Size = 11
        .name = "Calibri"
        .Color = wdColorBlack
    End With
    With wordDoc.Styles("Normal").Font
        .Bold = False
        .Size = 11
        .name = "Calibri"
        .Color = wdColorBlack
    End With
End Sub
Private Sub CreateHeader(wordDoc As Word.Document, rs As DAO.Recordset)
    Debug.Print wordDoc.Paragraphs.Count & " paragraphs, " & wordDoc.Tables.Count _
        & " tables while populating " & rs!strCustName
    wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.InsertBreak wdPageBreak
    wordDoc.Tables.Add wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range, 3, 4
    With wordDoc.Tables(wordDoc.Tables.Count)
        .Columns(1).SetWidth InchesToPoints(1), wdAdjustNone
        .Columns(2).SetWidth InchesToPoints(1), wdAdjustNone
        .Columns(3).SetWidth InchesToPoints(2), wdAdjustNone
        .Columns(4).SetWidth InchesToPoints(3), wdAdjustNone
        .Rows(1).SetHeight 18, wdRowHeightAuto
        .Rows(2).SetHeight 18, wdRowHeightExactly
        .Rows(3).SetHeight 18, wdRowHeightExactly
        With .Cell(1, 1)
            .Merge wordDoc.Tables(wordDoc.Tables.Count).Cell(1, 2)
            .Range.text = rs!strCustName
            .Range.Style = wordDoc.Styles("Heading 2")
        End With
        
        With .Cell(2, 1)
            .Range.text = "Tier:"
            .Range.Paragraphs.Alignment = wdAlignParagraphRight
        End With
        
        With .Cell(2, 2)
            .Range.text = rs!strTier
            '.Range.ParagraphFormat.SpaceBefore = 0
        End With
        
        With .Cell(3, 1)
            .Range.text = "Status"
            .Range.Paragraphs.Alignment = wdAlignParagraphRight
        End With
        
        With .Cell(3, 2)
            .Range.text = rs!strStatus
        End With
        
        With .Cell(1, 2)
            .VerticalAlignment = wdCellAlignVerticalBottom
            .Range.text = "Incident Notifications:"
            .Range.Paragraphs.Alignment = wdAlignParagraphRight
        End With
        
        With .Cell(1, 3)
            .VerticalAlignment = wdCellAlignVerticalBottom
            .Range.text = SafeInsert(rs!strIncNotEmail)
        End With
        
        With .Cell(2, 3)
            .Range.text = "Customer Surveys:"
            .Range.Paragraphs.Alignment = wdAlignParagraphRight
        End With
        
        With .Cell(2, 4)
            .Range.text = SafeInsert(rs!strCustSrvEmail)
        End With
        
        With .Cell(3, 3)
            .Range.text = "Performance Summaries:"
            .Range.Paragraphs.Alignment = wdAlignParagraphRight
        End With
        
        With .Cell(3, 4)
            .Range.text = SafeInsert(rs!strPerfSumEmail)
        End With
        
    End With
    wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.InlineShapes.AddHorizontalLineStandard
    Debug.Print wordDoc.Paragraphs.Count & " paragraphs, " & wordDoc.Tables.Count
    
End Sub
Reply With Quote