Solved

Split table above each Category

Posted on 2009-04-02
2
350 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
Comment Utility
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
Comment Utility
irudyk - That worked perfectly...thank you so much!
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
Microsoft Word is a program we have all encountered at some point, but very few of us have dug deep into its full scope of features, let alone customized it to suit our needs. Luckily making the ribbon (aka toolbar, first introduced in Word 2007) wo…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …

762 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

8 Experts available now in Live!

Get 1:1 Help Now