Quantcast
Channel: VBForums
Viewing all articles
Browse latest Browse all 15072

Add table with grid in datareport

$
0
0
Dear friends,
I have developed application for patient data management. I have option for patient diacharge card. I have used access as database and datareport to print discharge card. I wish to add a table in patient's pathology report column and want to print the same in datareport. Is it possible any way? If I copy table from word or excel and place it in userform textbox only datawithout table get paste. Please guide me. Below is the code of saving discharge card and print it.


Save button command for discharge card
Private Sub CommandButton10_Click()

If TextBox25.Text = "" Then
MsgBox "IPD no is blank"
Exit Sub
End If

On Error GoTo ErrorHandler


Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

Dim qry As String, i As Integer
Dim n As Long




cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "\\192.168.1.120\d\d\Database.accdb"

qry = "SELECT * FROM IPD WHERE [IP No] = '" + Me.TextBox25.Text + "'"


rst.Open qry, cnn, adOpenKeyset, adLockOptimistic



rst.Fields("History").Value = TextBox31.Value
rst.Fields("Examination").Value = TextBox32.Value
rst.Fields("Hospital course").Value = TextBox33.Value
rst.Fields("Investigations").Value = TextBox34.Value//here I want to place table
rst.Fields("Operation").Value = TextBox35.Value
rst.Fields("OTnote").Value = TextBox44.Value
rst.Fields("Treatment").Value = TextBox36.Value
rst.Fields("Advise").Value = TextBox37.Value

rst.Fields("Condition").Value = TextBox38.Value
rst.Fields("Diagnosis").Value = TextBox39.Value

rst.Fields("DC Username").Value = Label31.Caption
rst.Fields("DC Date&time").Value = Now()


rst.Update
MsgBox "Discharge card saved successfully for " & TextBox26.Text

rst.Close
cnn.Close







Exit Sub
ErrorHandler:

MsgBox "Oops, an error has occured." & vbCrLf & vbCrLf & "Error Code : " & Err.Number & " , " & Err.Description, vbCritical, "Error"
Exit Sub

End Sub

commandbutton to print discharge card
Sub Pdischarge()
On Error GoTo ErrorHandler





Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

Dim qry As String, i As Integer
Dim n As Long




cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "\\192.168.1.120\d\d\Database.accdb"

qry = "SELECT * FROM IPD WHERE [IP No] = '" + Me.TextBox25.Text + "'"


rst.Open qry, cnn, adOpenKeyset, adLockOptimistic


With DataReport3
Set .DataSource = rst
With .Sections("Section1").Controls



.Item("Name").Caption = "Patient Name: " & rst.Fields("Name").Value
.Item("RegNo").Caption = "Reg No.: " & rst.Fields("Reg No").Value
.Item("Age").Caption = "Age/Sex: " & rst.Fields("Age").Value & "/" & rst.Fields("Sex").Value
.Item("DOA").Caption = "Date of admission: " & Format(rst.Fields("Admitdate").Value, "dd/mm/yyyy")
.Item("IPDNo").Caption = "IPD No.: " & rst.Fields("Ip No").Value
.Item("DOD").Caption = "Date of discharge: " & Format(rst.Fields("Dischargedate").Value, "dd/mm/yyyy")
.Item("Diagnosis").Caption = rst.Fields("Diagnosis").Value
.Item("History").Caption = rst.Fields("History").Value
.Item("Examination").Caption = rst.Fields("Examination").Value
.Item("Hospital").Caption = rst.Fields("Hospital course").Value
.Item("Investigation").Caption = rst.Fields("Investigations").Value//I wish to print table with grid here

.Item("Treatment").Caption = rst.Fields("Treatment").Value
.Item("Advise").Caption = rst.Fields("Advise").Value
.Item("Condition").Caption = rst.Fields("Condition").Value
If rst.Fields("Operation").Value <> "" Then

.Item("Operation").Caption = rst.Fields("Operation").Value
.Item("Line9").Visible = True
.Item("Label10").Visible = True
.Item("Label22").Visible = True
Else
.Item("Operation").Caption = ""
.Item("Line9").Visible = False
.Item("Label10").Visible = False
.Item("Label22").Visible = False
End If




End With

.Show
.WindowState = 0
End With









Exit Sub
ErrorHandler:

MsgBox "Oops, an error has occured." & vbCrLf & vbCrLf & "Error Code : " & Err.Number & " , " & Err.Description, vbCritical, "Error"
Exit Sub


End Sub

Viewing all articles
Browse latest Browse all 15072

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>