Solved

Split table above each Category

Posted on 2009-04-02
2
352 Views
Last Modified: 2012-05-06
Thanks to the help of EE, I've got an export from Access to Word working great...with one exception.  Currently, the code below extracts data from my Access query and creates a new report in Word. It's creating a single table where I'm shading each row that's a Category header.

What I need to have it do is split the table BEFORE each Category header...so that I end up with separate tables for each Category.  I tried to apply some code I found on this site but I couldn't adapt it for my purposes:

objWord.Selection.SplitTable
wrdRange.InsertBefore rsNarrative.Fields(0).Value & vbCrLf

Can anyone assist me, please?  Thank you!
Option Compare Database
 

Private Sub cmdNewExport_Click()
 

Dim word 'the Word application

Dim doc 'the Word document

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim sql As String

Set db = CurrentDb

Dim objTable As word.Table

Dim objRange As word.Range

 

sql = "SELECT tbl_WeeklyCategory.CategoryName, tbl_WeeklyUpdate.WeeklyUpdName, tbl_WeeklyUpdate.WeeklyUpdDes"

sql = sql & " FROM tbl_WeeklyUpdate INNER JOIN tbl_WeeklyCategory ON tbl_WeeklyUpdate.WCatID = tbl_WeeklyCategory.WCatID"

sql = sql & " ORDER BY tbl_WeeklyUpdate.WCatID, tbl_WeeklyUpdate.WeeklyUpdName;"

 

Set rs = db.OpenRecordset(sql)

 

Set word = CreateObject("word.application")

Set doc = word.Documents.Add

  

With word

    .Visible = True

    Set doc = .Documents.Open("c:\PDE_Weekly_Report.doc", , False)

End With

 

doc.GoTo what:=wdGoToBookmark, Name:="Start"
 

    With word.Selection
 

        .TypeText Text:="Pre-Development Evaluation Weekly Summary"

        .TypeParagraph

        .TypeText Text:="Week Ending "

        doc.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _

        "DATE  \@ ""dddd d MMMM, yyyy"" ", PreserveFormatting:=True

        .MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend

        .MoveLeft Unit:=wdCharacter, Count:=33, Extend:=wdExtend

        .Font.Bold = wdToggle

        .ParagraphFormat.Alignment = wdAlignParagraphCenter

        .MoveDown Unit:=wdLine, Count:=1

        .TypeParagraph

    

    End With
 

doc.Tables.Add Range:=word.Selection.Range, NumRows:=1, NumColumns:= _

        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _

        wdAutoFitFixed
 

    With doc.PageSetup

        .LineNumbering.Active = False

        .Orientation = wdOrientPortrait

        .TopMargin = InchesToPoints(0.4)

        .BottomMargin = InchesToPoints(0.4)

        .LeftMargin = InchesToPoints(0.7)

        .RightMargin = InchesToPoints(0.6)

        .Gutter = InchesToPoints(0)

        .HeaderDistance = InchesToPoints(0.5)

        .FooterDistance = InchesToPoints(0.5)

        .PageWidth = InchesToPoints(8.5)

        .PageHeight = InchesToPoints(11)

    End With

        

    With doc.Tables(1)

        .Columns(1).SetWidth 100, wdAdjustNone

        .Columns(2).SetWidth 400, wdAdjustNone

    End With

        

    With word.Selection.Tables(1)

        If .Style <> "Table Grid" Then

            .Style = "Table Grid"

        End If

        .ApplyStyleHeadingRows = True

        .ApplyStyleLastRow = True

        .ApplyStyleFirstColumn = True

        .ApplyStyleLastColumn = True

    End With

 

   While Not rs.EOF

        If Not tmpCat = rs.Fields("CategoryName") Then

            With word.Selection

                .Style = ActiveDocument.Styles("Categories")

                .Font.Size = 11

                .SelectRow

                .Shading.Texture = wdTextureNone

                .Shading.ForegroundPatternColor = wdColorAutomatic

                .Shading.BackgroundPatternColor = wdColorLightYellow

                .TypeText Text:=rs.Fields("CategoryName").Value

                .MoveRight Unit:=wdCell

                .MoveRight Unit:=wdCell

            End With

            tmpCat = rs.Fields("CategoryName")

        End If

        

        With word.Selection

            .Style = ActiveDocument.Styles("Projects")

            .Font.Bold = wdToggle

            .Font.Size = 11

            .SelectRow

            .Shading.Texture = wdTextureNone

            .Shading.ForegroundPatternColor = wdColorAutomatic

            .Shading.BackgroundPatternColor = wdColorWhite

            .TypeText Text:=rs.Fields("WeeklyUpdName").Value

            .MoveRight Unit:=wdCell

        End With

        

        With word.Selection

            .Style = ActiveDocument.Styles("Desc")

            .Font.Size = 11

            .TypeText Text:=rs.Fields("WeeklyUpdDes").Value

            .MoveRight Unit:=wdCell

        End With

        rs.MoveNext

        

    Wend

    

    word.Dialogs(wdDialogFileSaveAs).Show
 

End Sub

Open in new window

0
Comment
Question by:setalley
2 Comments
 
LVL 23

Accepted Solution

by:
irudyk earned 250 total points
ID: 24052611
From what I can tell from what you've posted, the following modified code should work:

Option Compare Database

 

Private Sub cmdNewExport_Click()

 

Dim word 'the Word application

Dim doc 'the Word document

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim sql As String

Set db = CurrentDb

Dim objTable As word.Table

Dim objRange As word.Range

 

sql = "SELECT tbl_WeeklyCategory.CategoryName, tbl_WeeklyUpdate.WeeklyUpdName, tbl_WeeklyUpdate.WeeklyUpdDes"

sql = sql & " FROM tbl_WeeklyUpdate INNER JOIN tbl_WeeklyCategory ON tbl_WeeklyUpdate.WCatID = tbl_WeeklyCategory.WCatID"

sql = sql & " ORDER BY tbl_WeeklyUpdate.WCatID, tbl_WeeklyUpdate.WeeklyUpdName;"

 

Set rs = db.OpenRecordset(sql)

 

Set word = CreateObject("word.application")

Set doc = word.Documents.Add

  

With word

    .Visible = True

    Set doc = .Documents.Open("c:\PDE_Weekly_Report.doc", , False)

End With

 

doc.GoTo what:=wdGoToBookmark, Name:="Start"

 

    With word.Selection

 

        .TypeText Text:="Pre-Development Evaluation Weekly Summary"

        .TypeParagraph

        .TypeText Text:="Week Ending "

        doc.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _

        "DATE  \@ ""dddd d MMMM, yyyy"" ", PreserveFormatting:=True

        .MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend

        .MoveLeft Unit:=wdCharacter, Count:=33, Extend:=wdExtend

        .Font.Bold = wdToggle

        .ParagraphFormat.Alignment = wdAlignParagraphCenter

        .MoveDown Unit:=wdLine, Count:=1

        .TypeParagraph

    

    End With

 

doc.Tables.Add Range:=word.Selection.Range, NumRows:=1, NumColumns:= _

        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _

        wdAutoFitFixed

 

    With doc.PageSetup

        .LineNumbering.Active = False

        .Orientation = wdOrientPortrait

        .TopMargin = InchesToPoints(0.4)

        .BottomMargin = InchesToPoints(0.4)

        .LeftMargin = InchesToPoints(0.7)

        .RightMargin = InchesToPoints(0.6)

        .Gutter = InchesToPoints(0)

        .HeaderDistance = InchesToPoints(0.5)

        .FooterDistance = InchesToPoints(0.5)

        .PageWidth = InchesToPoints(8.5)

        .PageHeight = InchesToPoints(11)

    End With

        

    With doc.Tables(1)

        .Columns(1).SetWidth 100, wdAdjustNone

        .Columns(2).SetWidth 400, wdAdjustNone

    End With

        

    With word.Selection.Tables(1)

        If .Style <> "Table Grid" Then

            .Style = "Table Grid"

        End If

        .ApplyStyleHeadingRows = True

        .ApplyStyleLastRow = True

        .ApplyStyleFirstColumn = True

        .ApplyStyleLastColumn = True

    End With

 

   While Not rs.EOF

        If Not tmpCat = rs.Fields("CategoryName") Then

            With word.Selection

                .SplitTable

                .MoveDown

                .Style = ActiveDocument.Styles("Categories")

                .Font.Size = 11

                .SelectRow

                .Shading.Texture = wdTextureNone

                .Shading.ForegroundPatternColor = wdColorAutomatic

                .Shading.BackgroundPatternColor = wdColorLightYellow

                .TypeText Text:=rs.Fields("CategoryName").Value

                .MoveRight Unit:=wdCell

                .MoveRight Unit:=wdCell

            End With

            tmpCat = rs.Fields("CategoryName")

        End If

        

        With word.Selection

            .Style = ActiveDocument.Styles("Projects")

            .Font.Bold = wdToggle

            .Font.Size = 11

            .SelectRow

            .Shading.Texture = wdTextureNone

            .Shading.ForegroundPatternColor = wdColorAutomatic

            .Shading.BackgroundPatternColor = wdColorWhite

            .TypeText Text:=rs.Fields("WeeklyUpdName").Value

            .MoveRight Unit:=wdCell

        End With

        

        With word.Selection

            .Style = ActiveDocument.Styles("Desc")

            .Font.Size = 11

            .TypeText Text:=rs.Fields("WeeklyUpdDes").Value

            .MoveRight Unit:=wdCell

        End With

        rs.MoveNext

        

    Wend

    

    word.Dialogs(wdDialogFileSaveAs).Show

 

End Sub

Open in new window

0
 

Author Closing Comment

by:setalley
ID: 31565901
irudyk - That worked perfectly...thank you so much!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

It is often necessary in this forum and others to illustrate Word fields as text with the field delimiters replaced with the curly brackets that the delimiters resemble when field codes are being displayed on the document. This means that the text c…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

914 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now