Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Split table above each Category

Posted on 2009-04-02
2
Medium Priority
?
373 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 23

Accepted Solution

by:
irudyk earned 1000 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

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

715 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