| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.word.vba.userforms,microsoft.public.word.vba.beginners,microsoft.public.word.tables
|
|||
|
|||
Help with tables using VBA (Code messing up)
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. 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!!! |
|
#2
Posted to microsoft.public.word.vba.userforms,microsoft.public.word.vba.beginners,microsoft.public.word.tables
|
|||
|
|||
|
Help with tables using VBA (Code messing up)
I would suggest that you re-write to code so that it uses the Range object
rather than the Selection object. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "trezraven" wrote in message ps.com... 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. 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!!! |
| Reply |
| Thread Tools | |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Lengthy merge code | Mailmerge | |||
| Naming word tables or coding reference library with vba | Tables | |||
| Tables print distorted (vertically stretched) | Tables | |||
| Auto-numbering bug in tables - Word 2003 | Tables | |||
| Macro to find specific tables | Tables | |||
Linear Mode
