Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Help w/tables using VBA (Code messing up) 1

Status
Not open for further replies.
trezraven

trezraven

Programmer
Jan 16, 2007
21
US
I am using Office 2007 and I have created a form that pulls information from an Access database. My problem is the code works fine for the first two records, but it gets jumbled up after that. Below is a copy of my code.

Code: 
Public blnCancelled As Boolean 
Public rstart As Object 
Public rend As Object 
Private Sub btnCancel_Click() 
Opinion.blnCancelled = True 
Unload Me 
End Sub 


Private Sub btnGetData_Click() 
Dim conn                As New ADODB.Connection 
Dim rs                  As New ADODB.Recordset 
Dim lngConnectionState  As Long 
Dim strSQL              As String 
Dim Appellant           As String 
Dim Appellee            As String 
Dim OpinionDate         As Date 
Dim CaseNumber          As String 
Dim trange              As Range 
Dim ntable              As Table 
Dim rstart              As Long 
Dim rend                As Long 


'*****Set up the connection to the database***** 
conn.ConnectionString = "Provider=MSDAORA; Data Source=TSD1; User 
ID=Omitted for security; Password=Omitted for security" 


'*****Open the connection to the database***** 
conn.Open 
Set rs = New ADODB.Recordset 


'*****Check the state of the database***** 
lngConnectionState = conn.State 


'*****Set the datasource***** 
strSQL = "Select Appellant, Appellee, Opinion_Date, CaseNo " & _ 
            "From CMS.V_Macro4mandate " & _ 
            "Where Opinion_Date = '" & txtOpinionDate & "' " & _ 
            "Or CaseNo Like '" & 
IIf(IsNull(Opinion.txtCaseNumber.Value), "*", 
Opinion.txtCaseNumber.Value) & "'" & _ 
            "Order by Appellant " 


'*****Open the recordset***** 
rs.Open strSQL, conn, adOpenKeyset, adLockOptimistic 


'*****Get the data if not end of the recordset***** 
If rs.EOF Then 
MsgBox "No information in the database! Please verify your case number 
or opinion date.", vbCritical, "ERROR!" 
End If 


rs.MoveFirst 
If Not rs.EOF Then 
    Do Until rs.EOF 
Opinion.txtAppellant = rs.Fields("Appellant").Value & " " 
Opinion.txtAppellee = rs.Fields("Appellee").Value & " " 
Opinion.txtCaseNumber = rs.Fields("CaseNo").Value & " " 
Opinion.txtOpinionDate = rs.Fields("Opinion_Date").Value & " " 


'*****Hide the form so the document can come up***** 
Opinion.Hide 


'****Insert table***** 
Set trange = ActiveDocument.Range(rstart, rend) 
trange.Select 
trange.Collapse wdCollapseEnd 


Set ntable = ActiveDocument.Tables.Add(Range:=trange, NumRows:=8, 
NumColumns:=2, _ 
DefaultTableBehavior:=wdWord9TableBehavior, 
AutoFitBehavior:=wdAutoFitFixed) 


With ntable 
    If .Style <> "Table Grid" Then 
        .Style = "Table Grid" 
    End If 


    .ApplyStyleHeadingRows = True 
    .ApplyStyleLastRow = True 
    .ApplyStyleFirstColumn = True 
    .ApplyStyleLastColumn = True 
End With 


ntable.Rows.HeightRule = wdRowHeightAtLeast 
ntable.Rows.Height = InchesToPoints(0.3) 
ntable.Range.Font.AllCaps = True 
ntable.Range.Font.Size = 14 
ntable.Range.Font.Name = "Times New Roman" 
ntable.Range.Cells(1).VerticalAlignment = wdCellAlignVerticalTop 


With ntable 
    .Borders(wdBorderLeft).LineStyle = wdLineStyleNone 
    .Borders(wdBorderRight).LineStyle = wdLineStyleNone 
    .Borders(wdBorderVertical).LineStyle = wdLineStyleNone 
    .Borders(wdBorderTop).LineStyle = wdLineStyleNone 
    .Borders(wdBorderBottom).LineStyle = wdLineStyleNone 
    .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone 
    .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone 
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle 
    .Borders.Shadow = False 
End With 


'*****Add the formatting for the document***** 
With trange 
    Selection.Range.ParagraphFormat.LineSpacingRule = 
wdLineSpaceSingle 
    Selection.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft 
    Selection.SelectRow 
    Selection.Range.Cells.Merge 
    Selection.TypeText Text:="case of  " & txtAppellant.Value 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.SelectRow 
    Selection.Range.Cells.Merge 
    Selection.TypeText Text:="vs.    " & txtAppellee.Value 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.TypeText Text:="docket no.  " & txtCaseNumber.Value 
    Selection.MoveRight Unit:=wdCell 
    Selection.TypeText Text:="Opinion Filed  " & txtOpinionDate.Value 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.SelectRow 
    Selection.Range.Cells.Merge 
    Selection.TypeText Text:="rehearing petition filed" 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.SelectRow 
    Selection.Range.Cells.Merge 
    Selection.TypeText Text:="rehearing denied" 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.SelectRow 
    Selection.Range.Cells.Merge 
    Selection.TypeText Text:="rehearing granted" 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.SelectRow 
    Selection.Range.Cells.Merge 
    Selection.TypeText Text:="released for publication" 
    Selection.MoveDown Unit:=wdLine, Count:=1 
    Selection.SelectRow 
    Selection.TypeText Text:="date" 
    Selection.MoveRight Unit:=wdCell 
    Selection.TypeText Text:="Signed" 
    Selection.ClearParagraphAllFormatting 
    Selection.TypeParagraph 
    Selection.TypeParagraph 
    Selection.TypeParagraph 
    rs.MoveNext 
End With 
Loop 
End If 


rs.Close 
conn.Close 


'*****Search complete message***** 
MsgBox "The seach is complete.", vbOKOnly 


End Sub

This is the result once the code is ran.


CASE OF TONY J. WHITE
VS. STATE OF FLORIDA
DOCKET NO. 1D04-5296 OPINION FILED SEPTEMBER 29, 2005
REHEARING PETITION FILED
REHEARING DENIED
REHEARING GRANTED
RELEASED FOR PUBLICATION
DATE SIGNED


CASE OF TERRY HESTER
VS. STATE OF FLORIDA
DOCKET NO. 1D05-369 OPINION FILED SEPTEMBER 29, 2005
REHEARING PETITION FILED
REHEARING DENIED
REHEARING GRANTED
RELEASED FOR PUBLICATION
DATE SIGNED


DATE <<<<<This is out of order and is missing information
SIGNED


DOCKET NO. 1D04-4934 OPINION FILED SEPTEMBER 29, 2005
REHEARING PETITION FILED
REHEARING DENIED
REHEARING GRANTED
RELEASED FOR PUBLICATION
DATE SIGNED


CASE OF MURL HOMISTER
VS. STATE OF FLORIDA
DOCKET NO. 1D04-5406 OPINION FILED SEPTEMBER 29, 2005
REHEARING PETITION FILED
REHEARING DENIED
REHEARING GRANTED
RELEASED FOR PUBLICATION
DATE SIGNED


CASE OF CHARLES S. BURCH
VS. STATE OF FLORIDA
DOCKET NO. 1D03-2106 OPINION FILED SEPTEMBER 29, 2005
REHEARING PETITION FILED
REHEARING DENIED
REHEARING GRANTED
RELEASED FOR PUBLICATION
DATE SIGNED


Any help will be greatly appreciated!!!


 
Sort by date Sort by votes
Why are you using a table?

Why are you merging the cells of the table?

BTW: it would be much better if you used Styles, and did NOT use Selection.

I still looking at this code.

Gerry
My paintings and sculpture
 
Upvote 0 Downvote
I thought it would be easier to use a table so that the information will line up. I am open to other suggestions. I have never used Styles so if that is easier and you could point me in the right direction I am definitely willing to try it.
 
Upvote 0 Downvote
There is nothing inherently wrong with using a table. But why are you merging the cells? Oh, I think I see...sort of.

Other comments.

You declare:
Code: 
Public rstart As Object 
Public rend As Object

But also declare:
Code: 
Dim rstart  As Long 
Dim rend    As Long

Which is it? Are you using Option Explicit? Probably not because you use:
Code: 
Set trange = ActiveDocument.Range(rstart, rend)
trange.Select 
trange.Collapse wdCollapseEnd
without ever explicitly giving rstart, or rend any value. You then Select the range...then collapse it.

Are you trying to go to the end of the document? If so, then just use:
Code: 
Selection.EndKey Unit:=wdStory


You declare:
Code: 
Dim Appellant           As String 
Dim Appellee            As String 
Dim OpinionDate         As Date 
Dim CaseNumber          As String
but you never use any of these variables.

You use a bunch of code to apparently set the table with NO borders at all, except for Horizontal. Is this correct? If so, you can change:
Code: 
With ntable 
    .Borders(wdBorderLeft).LineStyle = wdLineStyleNone 
    .Borders(wdBorderRight).LineStyle = wdLineStyleNone 
    .Borders(wdBorderVertical).LineStyle = wdLineStyleNone 
    .Borders(wdBorderTop).LineStyle = wdLineStyleNone 
    .Borders(wdBorderBottom).LineStyle = wdLineStyleNone 
    .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone 
    .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone 
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle 
    .Borders.Shadow = False 
End With

to this:
Code: 
Dim var
  For var = 1 To 8
    .Borders(var).LineStyle = wdLineStyleNone
  Next
   .Borders(wdBorderHorizontal) = wdLineStyleSingle
This turns all borders to None, then explicitly turns Horizontal to SingleLine. NOTE: this is still in the With nTable code block!

Finally, you are using Selection to actually move through the table. This is not needed. You can put text directly into cells. Further, you do not need to Select a Row to merge the cells. BTW: personally, I dislike merged cells. They are a pain in the butt.

The following is altered code. The main difference is that each table has its Range have a Style - MyTableText.

Simply make a Style with the attributes you seem to want. This is indciated by:
Code: 
ntable.Range.Font.AllCaps = True 
ntable.Range.Font.Size = 14 
ntable.Range.Font.Name = "Times New Roman"
No need. Make a style that has these attributes, and use it. In the code below these attributes are in a Style named MyTableText. If you want to test without the Style, put those lines back in.
Code: 
Sub btnGetData_Click()
Dim conn                As New ADODB.Connection
Dim rs                  As New ADODB.Recordset
Dim lngConnectionState  As Long
Dim strSQL              As String
Dim nTable As Table

'*****Set up the connection to the database*****
conn.ConnectionString = "Provider=MSDAORA; Data Source=TSD1; User " & _
   "ID=Omitted for security; Password=Omitted for security"

'*****Open the connection to the database*****
conn.Open
Set rs = New ADODB.Recordset

'*****Check the state of the database*****
lngConnectionState = conn.State

'*****Set the datasource*****
strSQL = _
   "Select Appellant, Appellee, Opinion_Date, CaseNo " & _
   "From CMS.V_Macro4mandate " & _
   "Where Opinion_Date = '" & txtOpinionDate & "' " & _
   "Or CaseNo Like '" & _
   IIf(IsNull(opinion.txtCaseNumber.Value), "*", _
        opinion.txtCaseNumber.Value) & "'" & _
   "Order by Appellant "

'*****Open the recordset*****
rs.Open strSQL, conn, adOpenKeyset, adLockOptimistic

'*****Get the data if not end of the recordset*****
If rs.EOF Then
MsgBox "No information in the database! Please verify " & _
      "your case number " & _
      "or opinion date.", vbCritical, "ERROR!"
End If

rs.MoveFirst

If Not rs.EOF Then
  Do Until rs.EOF
    opinion.txtAppellant = _
        rs.Fields("Appellant").Value & " "
    opinion.txtAppellee = _
        rs.Fields("Appellee").Value & " "
    opinion.txtCaseNumber = _
        rs.Fields("CaseNo").Value & " "
    opinion.txtOpinionDate = _
        rs.Fields("Opinion_Date").Value & " "
        
  Selection.EndKey Unit:=wdStory
  Set nTable = ActiveDocument.Tables.Add _
    Range:=Selection.Range, NumRows:=8, _
      NumColumns:=2, _
      DefaultTableBehavior:=wdWord9TableBehavior, _
      AutoFitBehavior:=wdAutoFitFixed)
  With nTable
     With .Rows
        .HeightRule = wdRowHeightAtLeast
        .Height = InchesToPoints(0.3)
     End With
     Dim var
     For var = 1 To 8
       .Borders(var).LineStyle = wdLineStyleNone
     Next
     .Borders(wdBorderHorizontal) = wdLineStyleSingle
     .Range.Cells(1).VerticalAlignment = _
           wdCellAlignVerticalTop
            
     ' makes the whole table MyTableText style
     .Range.Style = "MyTableText"
            
     .Rows(1).Cells.Merge
     .Cell(1, 1).Range.Text = "case of  " & _
         txtAppellant.Value
            
     .Rows(2).Cells.Merge
     .Cell(2, 1).Range.Text = "vs.    " & _
         txtAppellee.Value
            
     .Cell(3, 1).Range.Text = "docket no.  " & _
         txtCaseNumber.Value
     .Cell(3, 2).Range.Text = "Opinion Filed  " & _
         txtOpinionDate.Value
            
     .Rows(4).Cells.Merge
     .Cell(4, 1).Range.Text = "rehearing petition filed"
            
     .Rows(5).Cells.Merge
     .Cell(5, 1).Range.Text = "rehearing denied"
            
     .Rows(6).Cells.Merge
     .Cell(6, 1).Range.Text = "rehearing granted"
            
     .Rows(7).Cells.Merge
     .Cell(7, 1).Range.Text = "released for publication"
            
     .Cell(8, 1).Range.Text = "Date"
     .Cell(8, 2).Range.Text = "Signed"
  End With
    Set nTable = Nothing
    Selection.EndKey Unit:=wdStory
    ' using the three paragraphs, BUT
    ' this should be a STYLE as well!!
    Selection.TypeText Text:=vbCrLf & vbCrLf & vbCrLf
    Loop
End If
End Sub

NOTE! I made some changes to the line breaks. Be sure to check them first if you get any errors.

BTW: this is assuming that what you are doing is make tables, one right after the other - each one placed at the current END of the document.

Is this from a template? I suspect not.

In any case, try using this, and let me know if it helped at all.

I have a feeling, because you are using Selection, things are not in the right place. With the above - actioning the tables without Selection - it may work better.

Gerry
My paintings and sculpture
 
Upvote 0 Downvote
Thanks Gerry! I am now getting runtime error 5834 Item with specified name does not exist.

The following line of code is highlighted:
Code: 
.Range.Style = "MyTableText"
 
Upvote 0 Downvote
Well of course it would if you had not actually made the Style. It you don't make the Style, then it does not exist.

I stated if you want to test without the Style, put the attributes lines back in.

To repeat, I removed the attribute lines:
Code: 
ntable.Range.Font.AllCaps = True 
ntable.Range.Font.Size = 14 
ntable.Range.Font.Name = "Times New Roman"
and used a created Style MyTableText, that has those attributes.

So, as I said, either make the Style - then you can use
Code: 
.Range.Style = "MyTableText"

OR

put the attribute lines back in, and remove the line that refers to the Style. You can not use a Style that does not exist.

Although I would very strongly suggest the use of Styles. Word is designed to use Styles.


Gerry
My paintings and sculpture
 
Upvote 0 Downvote
Duh!!! I feel like such an idiot! Thanks. Everything is working fine now.
 
Upvote 0 Downvote
No need to feel like an idiot.

What does working fine mean? Are you still having the original problem (where some things seemed to missing)? Does my code give you what you want?

Gerry
My paintings and sculpture
 
Upvote 0 Downvote
Yes your code gave me exactly what I wanted. Thanks again!!!
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
333
combo
combo
SLW89
  • Locked
  • Question
VBA newbie needs help
Replies
4
Views
287
Andrzejek
Andrzejek
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
464
hermanlaksko
hermanlaksko
M
  • Locked
  • Question
Reference Pivot Tables by name 1
Replies
2
Views
307
mintjulep
M
aldi07
  • Locked
  • Question
update a front-end databases with a new release using vba
Replies
2
Views
142
aldi07
aldi07

Part and Inventory Search

Sponsor

Back
Top