![]() |
|
#1
|
|||
|
|||
![]()
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 |
#2
|
|||
|
|||
![]()
as usual, found what's going on after posting this lol
the function Delimit was causing "Heading 1" to apply to everything after it. Removed that. |
![]() |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
antztaylor | Word | 3 | 11-06-2012 05:46 PM |
Lack of email addresses auto-populating | LarryK | Outlook | 0 | 10-10-2012 08:09 AM |
![]() |
Billy_McSkintos | Word VBA | 1 | 09-13-2011 05:50 AM |
![]() |
pajkul | Publisher | 1 | 01-23-2011 07:51 PM |
Not printing properly | Louis | Outlook | 0 | 08-05-2005 07:25 AM |