|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Adding tables to Created word document whilst other word document open Help
Hi all. I'm stumped but I think there is a simple solution out there. Any help would be appreciated.
I have an access database which I pull data out of and put in word documents. So far so good. It all works without tables in it if there are many word documents open. I have been requested to place in tables in the document. Also the script I have with tables works if no other word documents are open. PROBLEM With tables and other word documents open it goes to word document focus is when it reaches location where tables are added. That is script opens new word document > insert texts > gets to add table section > goes to a previously opened document where focus was > insert tables > I get frustrated I have spent 5 hours trying different things and come to the conclusion that I have no idea what I am doing. I think it has something to do with either the words " Active document" or "Selection" in the vba. I have added my vba below. The first section is creating recordsets so no issues there. The area of concern is green but everything purple is word related. I need to add the tables to the newly created word document using the script whilst other documents are open. Private Sub but_Unsatisfactory_Click() Dim objWord As Word.Application Dim doc As Word.Document Dim WordHeaderFooter As HeaderFooter Dim QueryA As DAO.Recordset Dim QueryB As DAO.Recordset Dim dbs As DAO.Database Dim strSQLA As String Dim strSQLB As String Dim myrange As Range Dim DA As String Dim DAX As String Dim Variable As String Dim Trange As Range If Forms!frm_Assess!lst_Referrals.Column(5) <> "" Then Set dbs = CurrentDb DA = Forms!frm_Assess!txt_DA DAX = """" & DA & """" 'Query SQL String for Checks strSQLA = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.CheckTitle, tbl_DAConCheck.CheckOutcome, tbl_DAConCheck.CheckComments, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No])=" & DAX & ") AND ((tbl_DAConCheck.CheckOutcome)<> ""Invisible"")) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Query SQL String for RAI strSQLB = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.RAIOutcome, tbl_DAConCheck.RAITitle, tbl_DAConCheck.RequestAdditionalInformation, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No]) = " & DAX & ") And ((tbl_DAConCheck.RAIOutcome) = True)) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Set Recordsets Set QueryA = dbs.OpenRecordset(strSQLA) Set QueryB = dbs.OpenRecordset(strSQLB) 'Open Word Set objWord = CreateObject("Word.Application") With objWord .Visible = True Set doc = .Documents.Add doc.SaveAs CurrentProject.Path & "\TestDoc.doc" End With 'Title/IntroPage objWord.Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle objWord.Selection.ParagraphFormat.SpaceAfter = 0 objWord.Selection.ParagraphFormat.SpaceBefore = 0 'Insert Gray Table ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _ 1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed With Selection.Tables(1) If .Style <> "Table Grid" Then .Style = "Table Grid" End If .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False End With objWord.Selection.Shading.Texture = wdTextureNone objWord.Selection.Shading.ForegroundPatternColor = wdColorAutomatic objWord.Selection.Shading.BackgroundPatternColor = -603937025 objWord.Selection.Font.Name = "Arial" objWord.Selection.Font.Size = 11 objWord.Selection.Font.Bold = True objWord.Selection.Font.Italic = False objWord.Selection.TypeText Text:="Council Report Summary" objWord.Selection.TypeParagraph objWord.Selection.Font.Bold = False objWord.Selection.TypeText Text:="The proposed development application does not comply with the requirements of Council's relevant policies." objWord.Selection.MoveDown Unit:=wdLine, Count:=1 objWord.Selection.Shading.Texture = wdTextureNone objWord.Selection.Shading.ForegroundPatternColor = wdColorAutomatic objWord.Selection.Shading.BackgroundPatternColor = wdColorAutomatic objWord.Selection.TypeParagraph objWord.Selection.TypeParagraph objWord.Selection.Font.Name = "Arial" objWord.Selection.Font.Size = 11 objWord.Selection.Font.Bold = True objWord.Selection.Font.Italic = False objWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter objWord.Selection.TypeText Text:=QueryA!ConditionCategory objWord.Selection.TypeParagraph objWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft objWord.Selection.Font.Bold = False objWord.Selection.TypeParagraph |
#2
|
||||
|
||||
There are numerous problems with your code, including the fact that despite declaring and setting a reference to the document you want to work with, your code then reverts to using 'ActiveDocument'. This and most of the rest of the code you're using if you simply used a purpose-designed template at the '.Documents.Add' point, with the required Style definitions, table and other standard content in-situ, instead of trying to use a new document at the created from Word's default template then applying all that content and using hard formatting to override the existing Styles. If the template contained bookmarks to denote where the QueryA & QueryB output were to go, that would further simplify the document creation.
PS: When posting code, please use the code tags, indicated by the # button on the posting menu.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
I was using Mail merge before and it was awful as it had a link at had issues. I understand that you are recommending a template which is different to mail merge however with no template the database works well on any computer even USB drive and does not have any issue with linking with documents further creating the document from scratch is highly flexible so if I want a tables of varying sizes it can be done easily with loops. Also It's working well except for the issue that you have highlighted with the Active document. Is there any alternatives to this referencing. I tried just placing
Code:
objword Code:
activedocument |
#4
|
||||
|
||||
objword is not the activedocument. doc is the active document. What you should have is something like:
Code:
Dim oTable As Word.Table 'name the table Dim oRng As Word.Range 'name a range With objWord .Visible = True Set doc = .Documents.Add doc.SaveAs CurrentProject.Path & "\TestDoc.doc" End With Set oRng = doc.Range 'Insert Gray Table Set oTable = doc.Tables.Add(Range:=oRng, NumRows:=1, NumColumns:= _ 1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed) With oTable If .Style <> "Table Grid" Then .Style = "Table Grid" End If .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False End With With oRng .Collapse 1 .Text = "Council Report Summary" & vbCr & vbCr & _ "The proposed development application does not comply with the requirements of Council's relevant policies." & vbCr & vbCr & _ QueryA!ConditionCategory & vbCr & vbCr .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle .ParagraphFormat.SpaceAfter = 0 .ParagraphFormat.SpaceBefore = 0 .Shading.Texture = wdTextureNone .Shading.ForegroundPatternColor = wdColorAutomatic .Shading.BackgroundPatternColor = -603937025 .Font.Name = "Arial" .Font.Size = 11 .Font.Bold = True .Font.Italic = False .Font.Bold = False .ParagraphFormat.Alignment = wdAlignParagraphLeft .Paragraphs(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter .Paragraphs(1).Range.Font.Bold = True End With
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
||||
|
||||
I think you'll find the following does the same as your existing code is intended to, but somewhat more consistently and efficiently:
Code:
Sub but_Unsatisfactory_Click() Dim objWord As Word.Application, doc As Word.Document Dim WordHeaderFooter As Word.HeaderFooter Dim QueryA As DAO.Recordset, QueryB As DAO.Recordset, dbs As DAO.Database Dim strSQLA As String, strSQLB As String Dim myrange As Range Dim DA As String, DAX As String Dim Variable As String Dim Trange As Range If Forms!frm_Assess!lst_Referrals.Column(5) <> "" Then Set dbs = CurrentDb DA = Forms!frm_Assess!txt_DA DAX = """" & DA & """" 'Query SQL String for Checks strSQLA = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.CheckTitle, tbl_DAConCheck.CheckOutcome, tbl_DAConCheck.CheckComments, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No])=" & DAX & ") AND ((tbl_DAConCheck.CheckOutcome)<> ""Invisible"")) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Query SQL String for RAI strSQLB = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.RAIOutcome, tbl_DAConCheck.RAITitle, tbl_DAConCheck.RequestAdditionalInformation, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No]) = " & DAX & ") And ((tbl_DAConCheck.RAIOutcome) = True)) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Set Recordsets Set QueryA = dbs.OpenRecordset(strSQLA) Set QueryB = dbs.OpenRecordset(strSQLB) 'Open Word Set objWord = CreateObject("Word.Application") With objWord .Visible = True .ScreenUpdating = False Set doc = .Documents.Add With doc 'Basic Document Format With .Styles(wdStyleNormal) .Font.Name = "Arial" .Font.Size = 11 With .ParagraphFormat .LineSpacingRule = wdLineSpaceSingle .SpaceAfter = 0 .SpaceBefore = 0 End With End With 'Insert Gray Table .Tables.Add Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=1, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed With .Tables(1) .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False With .Cell(1, 1).Range .Shading.BackgroundPatternColor = -603937025 .InsertAfter "Council Report Summary" & vbCr & _ "The proposed development application does not comply with the requirements of Council's relevant policies." .Paragraphs.First.Range.Style = wdStyleStrong End With End With With .Range .InsertAfter vbCr & vbCr & QueryA!ConditionCategory & vbCr & vbCr With .Paragraphs.Last.Previous.Previous .Range.Style = wdStyleStrong .Alignment = wdAlignParagraphCenter End With End With .SaveAs CurrentProject.Path & "\TestDoc.doc" End With .ScreenUpdating = True End With End If End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
||||
|
||||
As Paul suggests, your code could be massively simpler if you knew what template was being used for your Document.Add but ignoring that, you should be getting away from ActiveDocument and Selection objects completely.
Once you have done the following line, you should not touch ActiveDocument again Set doc = .Documents.Add eg. Code:
With objWord .Visible = True Set doc = .Documents.Add doc.SaveAs CurrentProject.Path & "\TestDoc.doc" End With 'Title/IntroPage With doc.Paragraphs(1).Range .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle .ParagraphFormat.SpaceAfter = 0 .ParagraphFormat.SpaceBefore = 0 .InsertAfter vbCr End With Dim aTbl as Word.Table 'Insert Gray Table Set aTbl = doc.Tables.Add Range:=doc.Paragraphs(2).Range, NumRows:=1, NumColumns:=1, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed With aTbl .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False End With
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia Last edited by Guessed; 03-17-2016 at 11:45 PM. Reason: Paul beat me to it |
#7
|
|||
|
|||
Thanks so much Macropod, Guessed and gMayor. It's great to know somebody out there can help me. I'm surprised at how differently you guys have approached it. Before I attempt to get it working with the advice provided I had a couple of questions.
1) The three of you have provided different solutions for setting the range for the table; gmayor; You have defined a variable Orng = doc.Range macropod; you have used .Characters.Last which I like cause my simple vba mind can make sense of it and I can see it working throughout the document. guessed; You have used .Paragraphs(2) Are there any real advantages of using any method over another. I must admit I don't really understand how the defining of rng = doc.Range works. Are you setting the whole document as a range? I sort of like just working from where the last character was are there any pitfalls with this? 2) Macropod could you please explain why you define the style (wdStyleNormal) at the beginning but do not seem to use it later? 3) What does turning screen updating off and on do? 4) What is the difference between saving at the start and the end? I'm very grateful for the prompt and thorough help amazing. Thanks Ron |
#8
|
||||
|
||||
Quote:
Quote:
It makes for faster code execution and less flickering, etc. Saving at the end saves your work; saving at the start doesn't.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Ok so far so good. With your help it is no longer not running. However now I get to the part where my code runs a loop (which I didn't share previously)and I'm trying to work out how to reference the last table created. I have written the code but it always types the text into table (2) when I want it in the latest. I understand why it does it but I don't know how to fix it. Is there a With .Tables(tables.last) command or similar or do I have to run some sort of counting loop. I have included the code. I have pretty much tried to extend with what you guys helped me with previously. Cheers.
Code:
Private Sub but_Unsatisfactory_Click() Dim objWord As Word.Application Dim doc As Word.Document Dim WordHeaderFooter As HeaderFooter Dim QueryA As DAO.Recordset Dim QueryB As DAO.Recordset Dim dbs As DAO.Database Dim strSQLA As String Dim strSQLB As String Dim myrange As Range Dim DA As String Dim DAX As String Dim Variable As String If Forms!frm_Assess!lst_Referrals.Column(5) <> "" Then Set dbs = CurrentDb DA = Forms!frm_Assess!txt_DA DAX = """" & DA & """" 'Query SQL String for Checks strSQLA = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.CheckTitle, tbl_DAConCheck.CheckOutcome, tbl_DAConCheck.CheckComments, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No])=" & DAX & ") AND ((tbl_DAConCheck.CheckOutcome)<> ""Invisible"")) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Query SQL String for RAI strSQLB = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.RAIOutcome, tbl_DAConCheck.RAITitle, tbl_DAConCheck.RequestAdditionalInformation, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No]) = " & DAX & ") And ((tbl_DAConCheck.RAIOutcome) = True)) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Set Recordsets Set QueryA = dbs.OpenRecordset(strSQLA) Set QueryB = dbs.OpenRecordset(strSQLB) 'Open Word Set objWord = CreateObject("Word.Application") With objWord .Visible = True .ScreenUpdating = False Set doc = .Documents.Add With doc 'Basic Document Format With .Styles(wdStyleNormal) .Font.Name = "Arial" .Font.Size = 11 With .ParagraphFormat .LineSpacingRule = wdLineSpaceSingle .SpaceAfter = 0 .SpaceBefore = 0 End With End With 'Title/IntroPage 'Insert Gray Table .Tables.Add Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=1, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed With .Tables(1) .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False With .Cell(1, 1).Range .Shading.BackgroundPatternColor = -603937025 .InsertAfter "Council Report Summary" & vbCr & _ "The proposed development application does not comply with the requirements of Council's relevant policies." .Paragraphs.First.Range.Style = wdStyleStrong End With End With With .Range .InsertAfter vbCr & vbCr & QueryA!ConditionCategory & vbCr & vbCr With .Paragraphs.Last.Previous.Previous .Range.Style = wdStyleStrong .Alignment = wdAlignParagraphCenter End With End With 'Checks Loop Start Variable = QueryA!ConditionCategory Do While Not QueryA.EOF 'Check if Check Category is the same as previous if not type new category If Variable = QueryA!ConditionCategory Then Else With .Range .InsertAfter QueryA!ConditionCategory & vbCr End With End If 'Make sure check has a title and insert table fill in with notes If IsNull(QueryA!CheckTitle) = True Then Else .Tables.Add Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=2, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed With .Tables(2) .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False With .Cell(1, 1).Range If IsNull(QueryA!CheckTitle) = True Then Else .InsertAfter QueryA!CheckTitle End If End With With .Cell(1, 2).Range If IsNull(QueryA!CheckOutcome) = True Then Else .InsertAfter QueryA!CheckOutcome & vbCr End If If IsNull(QueryA!CheckComments) = True Then Else .InsertAfter QueryA!CheckComments End If 'End with for Cell End With 'End with for Tables End With With .Range .InsertAfter vbCr & vbCr With .Paragraphs.Last.Previous.Previous .Range.Style = wdStyleStrong .Alignment = wdAlignParagraphLeft End With 'End with for Paragraph End With 'End If for Check that there is data for CheckTitle End If Variable = QueryA!ConditionCategory QueryA.MoveNext Loop QueryA.Close 'Checks Loop Ends 'End With 'Not sure if this should be here .SaveAs CurrentProject.Path & "\TestDoc.doc" 'end with doc End With .ScreenUpdating = True 'end with objword End With Set objWord = Nothing Else MsgBox "Referal Completed Date Required", 0, "Date Required" End If End Sub |
#10
|
||||
|
||||
If you want to reference a table you're creating, use code like:
Code:
Dim Tbl as Table .... Set Tbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=2, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed) With Tbl
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Thanks Paul. Working a treat.
I'm trying to get my head around the ranges and formatting still. I want to get the text bold and centered for QueryA!ConditionCategory. It's bold but it's not centering. I'm trying to work out the following.. what exactly the .range is specifying (it has no reference to a location next to it) What paragraphs.last.previous.previous doing (is it going to the last paragraph then jumping back two paragraphs to take into account the vbCr's?) how come style has a .range in front of it but alignment doesn't. (I tried putting .range in front of alignment and it didn't like it) Code:
With .Range .InsertAfter QueryA!ConditionCategory & vbCr & vbCr With .Paragraphs.Last.Previous.Previous .Range.Style = wdStyleStrong .Alignment = wdAlignParagraphCentre End With End With |
#12
|
||||
|
||||
The code I posted for the 'QueryA!ConditionCategory' processing is sufficient for output that consists of a single paragraph. If not, you'd need to define a range object and use that.
The .Range object as used in the snippet you quoted explicitly applies to the third-last paragraph in the document. Since .Alignment is a .Paragraphs property and not a .Range property, it uses the same .Paragraphs reference as .Range. As most of my Word knowledge & programming skills are self taught, developed whilst helping other users solve their Word productivity issues, I'm not really in a position to recommend something specific to your needs. That said, a book you might find useful is The Secret Life of Word: A Professional Writer's Guide to Microsoft Word Automation, by R Delwood, published by XML Press in 2011(http://xmlpress.net/publications/word-secrets/). I contributed content for and did much of the technical review of this book. This isn't a programming book as such (though it does have some programming in it) and doesn't profess to teach you how to program. Rather, it shows how to combine Word's various tools to achieve whatever the desired result might be. Another that I contributed to (and has much more programming in it) is Word Hacks, by A Savikas, published by O'Reilly Media in 2005 (http://shop.oreilly.com/product/9780596004934.do). I contributed content for this book also. Although it pre-dates Office 2007, much of the content is still relevant. On a side note, if your code was properly structured, its logic would be easier to follow and you would need fewer comments. For example: Code:
Private Sub but_Unsatisfactory_Click() Dim QueryA As DAO.Recordset Dim QueryB As DAO.Recordset Dim dbs As DAO.Database Dim strSQLA As String, strSQLB As String Dim DA As String, DAX As String Dim Variable As String Dim wdApp As Word.Application Dim wdDoc As Word.Document Dim wdRng As Word.Range Dim wdTbl As Word.Table If Forms!frm_Assess!lst_Referrals.Column(5) <> "" Then Set dbs = CurrentDb DA = Forms!frm_Assess!txt_DA DAX = """" & DA & """" 'Query SQL String for Checks strSQLA = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.CheckTitle, tbl_DAConCheck.CheckOutcome, tbl_DAConCheck.CheckComments, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No])=" & DAX & ") AND ((tbl_DAConCheck.CheckOutcome)<> ""Invisible"")) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Query SQL String for RAI strSQLB = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.RAIOutcome, tbl_DAConCheck.RAITitle, tbl_DAConCheck.RequestAdditionalInformation, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No]) = " & DAX & ") And ((tbl_DAConCheck.RAIOutcome) = True)) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Set Recordsets Set QueryA = dbs.OpenRecordset(strSQLA) Set QueryB = dbs.OpenRecordset(strSQLB) 'Start Word Set wdApp = CreateObject("Word.Application") With wdApp .Visible = True .ScreenUpdating = False 'Create a New Document Set wdDoc = .Documents.Add With wdDoc 'Basic Document Format With .Styles(wdStyleNormal) .Font.Name = "Arial" .Font.Size = 11 With .ParagraphFormat .LineSpacingRule = wdLineSpaceSingle .SpaceAfter = 0 .SpaceBefore = 0 End With End With 'Title/IntroPage 'Insert Gray Table Set wdTbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=1, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed) With wdTbl .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False With .Cell(1, 1).Range .Shading.BackgroundPatternColor = -603937025 .InsertAfter "Council Report Summary" & vbCr & _ "The proposed development application does not comply with the requirements of Council's relevant policies." .Paragraphs.First.Range.Style = wdStyleStrong End With End With 'Make space for query insertion .Range.InsertAfter vbCr & vbCr & vbCr & vbCr Set wdRng = .Paragraphs.Last.Previous.Previous.Range 'Insert & format Query With wdRng .InsertBefore QueryA!ConditionCategory .Style = wdStyleStrong .Paragraphs.Alignment = wdAlignParagraphCenter End With 'Checks Loop Start Variable = QueryA!ConditionCategory Do While Not QueryA.EOF 'Check if Check Category is the same as previous if not type new category If Variable <> QueryA!ConditionCategory Then .Range.InsertAfter vbCr Set wdRng = .Paragraphs.Last.Previous.Range 'Insert & format Query With wdRng .InsertBefore QueryA!ConditionCategory .Style = wdStyleStrong .Paragraphs.Alignment = wdAlignParagraphCenter End With End If 'Make sure check has a title and insert table fill in with notes If IsNull(QueryA!CheckTitle) = False Then Set wdTbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=2, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed) With wdTbl .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False If IsNull(QueryA!CheckTitle) = False Then .Cell(1, 1).Range.Text = QueryA!CheckTitle If IsNull(QueryA!CheckOutcome) = False Then .Cell(1, 2).Range.Text = QueryA!CheckOutcome If IsNull(QueryA!CheckComments) = False Then .Cell(1, 2).Range.End.InsertBefore vbCr & QueryA!CheckComments End With End If Variable = QueryA!ConditionCategory QueryA.MoveNext Loop QueryA.Close 'Save the document .SaveAs CurrentProject.Path & "\TestDoc.doc" End With .ScreenUpdating = True End With Else MsgBox "Referal Completed Date Required", 0, "Date Required" End If Set wdRng = Nothing: Set wdTbl = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
Thanks Paul I got it working well with your help. I have a few other hurdles further down the track with sub routines that I'll post new threads with in the next couple of weeks. I had a couple small issues with the last code which you help me with I changed it and now works but I can't explain exactly why. I thought it would be good to place up the working version just in case someone else is interested.
it didn't like the below code especially the last if is null statement not sure why though so I changed it back to the other format and it worked ok. Code it didn't like Code:
If IsNull(QueryA!CheckTitle) = False Then .Cell(1, 1).Range.Text = QueryA!CheckTitle If IsNull(QueryA!CheckOutcome) = False Then .Cell(1, 2).Range.Text = QueryA!CheckOutcome If IsNull(QueryA!CheckComments) = False Then .Cell(1, 2).Range.End.InsertBefore vbCr & QueryA!CheckComments End With Code:
With .Cell(1, 1).Range If IsNull(QueryA!CheckTitle) = True Then Else .InsertAfter QueryA!CheckTitle End If End With With .Cell(1, 2).Range If IsNull(QueryA!CheckOutcome) = True Then Else .InsertAfter QueryA!CheckOutcome & vbCr End If If IsNull(QueryA!CheckComments) = True Then Else .InsertAfter QueryA!CheckComments End If 'End with for Cell End With 'End with for Tables End With Code:
If IsNull(QueryA!CheckTitle) = False Then Set wdRng = .Characters.Last With wdRng .InsertAfter vbCr End With Working Code: Code:
Private Sub but_Unsatisfactory_Click() Dim QueryA As DAO.Recordset Dim QueryB As DAO.Recordset Dim dbs As DAO.Database Dim strSQLA As String, strSQLB As String Dim DA As String, DAX As String Dim Variable As String Dim wdApp As Word.Application Dim wdDoc As Word.Document Dim wdRng As Word.Range Dim Tbl As Word.Table Dim WordHeaderFooter As HeaderFooter Dim myrange As Range If Forms!frm_Assess!lst_Referrals.Column(5) <> "" Then Set dbs = CurrentDb DA = Forms!frm_Assess!txt_DA DAX = """" & DA & """" 'Query SQL String for Checks strSQLA = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.CheckTitle, tbl_DAConCheck.CheckOutcome, tbl_DAConCheck.CheckComments, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No])=" & DAX & ") AND ((tbl_DAConCheck.CheckOutcome)<> ""Invisible"")) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Query SQL String for RAI strSQLB = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.RAIOutcome, tbl_DAConCheck.RAITitle, tbl_DAConCheck.RequestAdditionalInformation, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _ "FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _ "WHERE (((tbl_DA.[DA No]) = " & DAX & ") And ((tbl_DAConCheck.RAIOutcome) = True)) " & _ "ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;" 'Set Recordsets Set QueryA = dbs.OpenRecordset(strSQLA) Set QueryB = dbs.OpenRecordset(strSQLB) 'Open Word Set wdApp = CreateObject("Word.Application") With wdApp .Visible = True .ScreenUpdating = False 'Create a new document Set wdDoc = .Documents.Add With wdDoc 'Basic Document Format With .Styles(wdStyleNormal) .Font.Name = "Arial" .Font.Size = 11 With .ParagraphFormat .LineSpacingRule = wdLineSpaceSingle .SpaceAfter = 0 .SpaceBefore = 0 End With End With 'Title/IntroPage 'Insert Gray Table Set wdTbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=1, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed) With wdTbl .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False With .Cell(1, 1).Range .Shading.BackgroundPatternColor = -603937025 .InsertAfter "Council Report Summary" & vbCr & _ "The proposed development application does not comply with the requirements of Council's relevant policies." .Paragraphs.First.Range.Style = wdStyleStrong End With End With 'Make space for query insertion .Range.InsertAfter vbCr & vbCr & vbCr & vbCr Set wdRng = .Paragraphs.Last.Previous.Previous.Range 'Insert & Format Query With wdRng .InsertBefore QueryA!ConditionCategory .Style = wdStyleStrong .Paragraphs.Alignment = wdAlignParagraphCenter End With 'Checks Loop Start Variable = QueryA!ConditionCategory Do While Not QueryA.EOF 'Check if Check Category is the same as previous if not type new category If Variable <> QueryA!ConditionCategory Then .Range.InsertAfter vbCr Set wdRng = .Paragraphs.Last.Previous.Range 'Insert & format Query With wdRng .InsertBefore vbCr & vbCr & QueryA!ConditionCategory & vbCr .Style = wdStyleStrong .Paragraphs.Alignment = wdAlignParagraphCenter End With End If 'Make sure check has a title and insert table fill in with notes If IsNull(QueryA!CheckTitle) = False Then Set wdRng = .Characters.Last With wdRng .InsertAfter vbCr End With Set wdTbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=2, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed) With wdTbl .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False With .Cell(1, 1).Range If IsNull(QueryA!CheckTitle) = True Then Else .InsertAfter QueryA!CheckTitle End If End With With .Cell(1, 2).Range If IsNull(QueryA!CheckOutcome) = True Then Else .InsertAfter QueryA!CheckOutcome & vbCr End If If IsNull(QueryA!CheckComments) = True Then Else .InsertAfter QueryA!CheckComments End If 'End with for Cell End With 'End with for Tables End With End If Variable = QueryA!ConditionCategory QueryA.MoveNext Loop QueryA.Close 'Checks Loop Ends 'Save the document .SaveAs CurrentProject.Path & "\TestDoc.doc" 'end with doc End With .ScreenUpdating = True 'end with objword End With Else MsgBox "Referal Completed Date Required", 0, "Date Required" End If Set wdRng = Nothing: Set wdTbl = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing |
#14
|
||||
|
||||
Quote:
Code:
If IsNull(QueryA!CheckTitle) <> True Then .Cell(1, 1).Range.Text = QueryA!CheckTitle If IsNull(QueryA!CheckOutcome) <> True Then .Cell(1, 2).Range.Text = QueryA!CheckOutcome If IsNull(QueryA!CheckComments) <> True Then .Cell(1, 2).Range.End.InsertBefore vbCr & QueryA!CheckComments
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
Hi Paul for formatting the width of columns of the New Tables I'm rocking the below code but it seems a bit hit and miss. Sometimes it says it has some server error but other times it's OK. I'm not sure if it's wdPreferredWidthPoints that it doesn't like but it's somewhere around that region. Cheers.
Code:
Set wdTbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=17, NumColumns:=2, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed) With wdTbl .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False .Borders(wdBorderLeft).LineStyle = wdLineStyleNone .Borders(wdBorderRight).LineStyle = wdLineStyleNone .Borders(wdBorderTop).LineStyle = wdLineStyleNone .Borders(wdBorderBottom).LineStyle = wdLineStyleNone .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone .Borders(wdBorderVertical).LineStyle = wdLineStyleNone .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone .Borders.Shadow = False With .Columns(1) .PreferredWidthType = wdPreferredWidthPoints .PreferredWidth = CentimetersToPoints(3) End With With .Columns(2) .PreferredWidthType = wdPreferredWidthPoints .PreferredWidth = CentimetersToPoints(13) End With |
Tags |
add, tables, vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Adding furigana to a Word document | rjribbit | Word | 0 | 12-03-2015 09:33 AM |
Inexperienced user having dificulty adding text to document I created. Fixed text moves around. | Athalwolf | Word | 2 | 02-08-2015 09:08 AM |
Error message opening a document in Word "Word cannot open this file because it is larger than 512 M | poonamshedge | Word | 2 | 09-11-2014 06:11 AM |
Adding and Moving parts of a document in Word | PauledInAction | Word | 4 | 07-13-2012 02:38 PM |
Adding bullets in a protected Word document | Cindylu3 | Word | 0 | 10-03-2008 03:16 PM |