How to populate a data report row by row - vb6

I have to change a very old application written in Vb6 with Data Report.
Actually displays a query records with only one field named txtdata.
Now I would display always one field (txtdata) but with different text size and style depending on whether it starts with a # or not.
I thought to check records for records if it starts with # or not and set text style and size for each record.
How can I do?
Dim rs As Adodb.Recordset
Dim sql As String
Dim regtratt As
.................
' I have a Data Report with textbox named txtdata in Section1
sql = ""
sql = sql + "SELECT txtdata "
sql = sql + "FROM journal "
sql = sql + "WHERE cod=421 "
sql = sql + "ORDER BY id "
Set rs = xOpenRecordset(sql, cnOnline)
If rs.RecordCount > 0 Then
Set regtratt.DataSource = rs
regtratt.DataMember = ""
' I want to change the font according to the text but I don't know how to because DataSource=rs takes the records.
'If InStr("#", regtratt.Sections("Section1").Controls(1).Item.Value) Then
' regtratt.Sections("Section1").Controls(1).Font.size = 20
' regtratt.Sections("Section1").Controls(1).Font.Bold = True
'End If
regtratt.Orientation = rptOrientLandscape
regtratt.WindowState = vbMaximized
regtratt.Font.Name = "courier new"
regtratt.Refresh
regtratt.Show vbModal
Unload regtratt
Else
MsgBox ("Sorry No data")
End If

Related

Count specific records from an existing recordset without using the select count method

I have a recordset from an sql query, from which I get the following result:
---------------
| Column_Color |
|---------------|
| Blue |
| Red |
| Magenta |
| Red |
| Grey |
As you can see, I have 2 records with the RED color.
I wonder if there is any possible way or method to count all the records having the RED color, from the column Column_Color ?
I am trying to avoid creating a new query with the SELECT COUNT method and I want to know if there is any possible method to count the RED colors, from the existing recordset. The desired result is to have the number 2 as a result.
My real recordset is bellow: I want to calculate the field named dbo.Products.F_antislip_sub
<%
Dim RS_proionta
Dim RS_proionta_cmd
Dim RS_proionta_numRows
Set RS_proionta_cmd = Server.CreateObject ("ADODB.Command")
RS_proionta_cmd.ActiveConnection = MM_sindesi_STRING
RS_proionta_cmd.CommandText=sql_q 'Here is my query...
RS_proionta_cmd.Prepared = true
Set RS_proionta = RS_proionta_cmd.Execute
RS_proionta_numRows = 0
%>
Once you set your recordset's CursorLocation property to adUseClient you can move between records and apply filters locally.
Const adUseClient = 3
Dim RS_proionta
Dim RS_proionta_cmd
Dim RS_proionta_numRows
Set RS_proionta_cmd = CreateObject ("ADODB.Command")
RS_proionta_cmd.ActiveConnection = MM_sindesi_STRING
RS_proionta_cmd.CommandText=sql_q 'Here is my query...
RS_proionta_cmd.Prepared = true
Set RS_proionta = CreateObject ("ADODB.Recordset")
RS_proionta.CursorLocation = adUseClient
RS_proionta.Open RS_proionta_cmd
RS_proionta.Filter = "Column_Color = 'Red'" 'filter Reds
Dim redCount
redCount = RS_proionta.RecordCount 'redCount must equals to 2 now
Response.Write "There are " & redCount & " reds."
RS_proionta.Filter = "" 'remove filter
If Not RS_proionta.EOF Then
RS_proionta.MoveFirst ' move cursor back to beginning
End If
'now other jobs with RS_proionta can be done again from scratch
RS_proionta.Close
Notice: This method should not always be considered the fastest way. If your recordset is a bulky one with lots of rows and columns with large data, an explicit Select Count query may be faster than this thanks to database server optimizations and server-side cursors.

Populate and sort a ComboBox from another ComboBox, VBA

Hi Everyone I am having trouble getting a ComboBox to sort, when another combobox is selected.
I think I have the Right SQL Syntax but I cant seem to get the vba to run it through; currently the vba returns all of the states in the recordset regardless of the company.
Private Sub CboCountry_Click()
Set db = CurrentDb
Dim SQLStr As String
Set RsState = db.OpenRecordset("T2States", dbOpenSnapshot, dbSeeChanges)
'populates combobox with recordset, that is defined by the country input from the form
RsState.MoveFirst
Do While Not RsState.EOF
Me.CboState.RowSource = Me.CboState.RowSource & RsState("StateID") & ";" & RsState("State") & ";"
RsState.MoveNext
Loop
I think this is the right SQL String but I'm having trouble to get it to work.
'SQLStr = "SELECT T2States.StateID, T2States.States, T2States.CountryID" & _
" FROM T2States GROUP BY T2States.StatesID" & _
" WHERE T2States.CountryID = """ & Me.CboCountry.Value & """"
Any help will be greatly appreciated.
Edit#1
See Full Code below, the error that pops up when I substitute SQLStr into the Openrecordset is a Run-time error '3078' the microsoft access database engine cannot find the input table or query 'SQLStr'. Make sure it exists and that its name is spelled correctly.
What should happen is when a country is selected from CboCountry combobox, it will load the CboState combobox by sorting the recordset by CountryID
see below for both code parts
Private Sub Form_Load()
Set db = CurrentDb
Set RsCompany = db.OpenRecordset("T1Company", dbOpenDynaset, dbSeeChanges)
Set RsCountry = db.OpenRecordset("T2Countries", dbOpenSnapshot, dbSeeChanges)
Set RsAddress = db.OpenRecordset("T1Addresses", dbOpenDynaset, dbSeeChanges)
Set RsAddressType = db.OpenRecordset("T2AddressType", dbOpenSnapshot, dbSeeChanges)
Set RsCompanyAddress = db.OpenRecordset("T3Company_Address", dbOpenDynaset, dbSeeChanges)
Me.CboCountry = Null
Me.TxtAddress1 = Null
Me.TxtAddress2 = Null
Me.TxtAddress3 = Null
Me.TxtCity = Null
Me.CboAddressType = Null
Me.CboCountry = Null
Me.CboState = Null
Me.TxtPostalCode = Null
Me.TxtCompanyID = Null
Me.TxtLegalName = Null
Me.TxtNickname = Null
Me.TxtAddressID = Null
RsCountry.MoveFirst
Do While Not RsCountry.EOF
Me.CboCountry.RowSource = Me.CboCountry.RowSource & RsCountry("CountryID") & ";" & RsCountry("Country") & ";"
RsCountry.MoveNext
Loop
RsAddressType.MoveFirst
Do While Not RsAddressType.EOF
Me.CboAddressType.RowSource = Me.CboAddressType.RowSource & RsAddressType("AddressTypeID") & ";" & RsAddressType("AddressType") & ";"
RsAddressType.MoveNext
Loop
Me.TxtLegalName.SetFocus
End Sub
Private Sub CboCountry_Click()
Set db = CurrentDb
Dim SQLStr As String
'SQLStr = "SELECT T2States.StateID, T2States.State, T2States.CountryID" & _
" FROM T2States" & _
" WHERE T2States.CountryID = """ & Me.CboCountry.Value & """"
Set RsState = db.OpenRecordset("T2States", dbOpenDynaset, dbSeeChanges)
'populates combobox with recordset, that is defined by the country input from the form
RsState.MoveFirst
Do While Not RsState.EOF
Me.CboState.RowSource = Me.CboState.RowSource & RsState("StateID") & ";" & RsState("State") & ";"
RsState.MoveNext
Loop
End Sub
Let us see
1- sure you've to append with
Having T2States.States, T2States.CountryID
2- Error exist in it, extra 's' in the Column name:
GROUP BY T2States.StatesID
3- put all the code and i'll check with you what you miss.
best regards
This one turned out to be a quick fix in the Property Sheet under the DATA tab, the Row Source Type had to be changed back to 'Table/Query' from a 'Value'.
There is VBA that could account for this but it was just a simple as changing that Row Source.
The Reason for the mix up, for a quick bit of background if it helps, is that all my combo boxes are unbound and I was binding them with VBA Recordsets so the rowsource has to be a value list - Essentially the VBA is writing the list everytime it loads.
Where as when I started using SQL to generate the recordset, even though it was in VBA I had to change the property back to Table/Query.
Thanks.

Access 2010 - Run-time error 3022

I'm trying to add records to an exisiting table called "Topics" (section as of "For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected" in the code below).
When executing the code i always get "Run-time error '3022': The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. So it goes wrong at the creation of the Autonumber in the field "ID" (= the only field that is indexed - no duplicates).
When debugging, line "TopicRecord.Update" in the code below is highlighted.
I have read several posts on this topic on this forum and on other forums but still cannot get this to work - i must be overlooking something....
Private Sub Copy_Click()
Dim JournalEntrySourceRecord, JournalEntryDestinationRecord, TopicRecord As Recordset
Dim JournalEntryToCopyFromCtl, JournalEntryToCopyToCtl, JournalEntryDateCreatedCtl, SelectedTopicsCtl As Control
Dim Counter, intI As Integer
Dim SelectedTopic, varItm As Variant
Set JournalEntryToCopyFromCtl = Forms![Copy Journal Entry]!JournalEntryToCopyFrom
Set JournalEntryToCopyToCtl = Forms![Copy Journal Entry]!JournalEntryToCopyTo
Set JournalEntryDateCreatedCtl = Forms![Copy Journal Entry]!JournalEntryDateCreated
Set JournalEntrySourceRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyFromCtl.Value)
Set JournalEntryDestinationRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyToCtl.Value)
Set SelectedTopicsCtl = Forms![Copy Journal Entry]!TopicsToCopy
Set TopicRecord = CurrentDb.OpenRecordset("Topics", dbOpenDynaset, dbSeeChanges)
With JournalEntryDestinationRecord
.Edit
.Fields("InitiativeID") = JournalEntrySourceRecord.Fields("InitiativeID")
.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
.Fields("Comment") = JournalEntrySourceRecord.Fields("Comment")
.Fields("Active") = "True"
.Fields("InternalOnly") = JournalEntrySourceRecord.Fields("InternalOnly")
.Fields("Confidential") = JournalEntrySourceRecord.Fields("Confidential")
.Update
.Close
End With
JournalEntrySourceRecord.Close
Set JournalEntrySourceRecord = Nothing
Set JournalEntryDestinationRecord = Nothing
For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected
TopicRecord.AddNew
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter) = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Next Counter
TopicRecord.Fields("JournalEntryID") = JournalEntryToCopyToCtl.Value
TopicRecord.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
TopicRecord.Update
Next SelectedTopic
TopicRecord.Close
Set TopicRecord = Nothing
End Sub
First, your Dims won't work as you expect. Use:
Dim JournalEntrySourceRecord As Recordset
Dim JournalEntryDestinationRecord As Recordset
Dim TopicRecord As Recordset
Second, it looks like you get your ID included here:
TopicRecord.Fields(Counter)
or Topic is a query that includes it somehow. Try to specify the fields specifically and/or debug like this:
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter).Value = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Debug.Print Counter, TopicRecord.Fields(Counter).Name
Next Counter

CurrentRegion.Select and Table format in VBS

I'm very new (1 week) to visual basic and basically I'm trying to automate some repetitive work, now to the point , within a number of files produced with varying data I need to format the selected range as a table (medium 9) but i'm in a block at the moment and need some help and would really appreciate it, here is what i have so far>>>>
Option Explicit
Dim strDate, strRepDate, strPath, strPathRaw , strDate2
dim dteTemp, dteDay, dteMth, dteYear, newDate, myDate
myDate = Date()
dteTemp = DateAdd("D", -1, myDate)
dteDay = DatePart("D", dteTemp)
dteMth = DatePart("M", dteTemp)
dteYear = DatePart("YYYY", dteTemp)
If (Len(dteDay) = 1) Then dteDay = "0" & dteDay
If (Len(dteMth) = 1) Then dteMth = "0" & dteMth
strDate = dteYear&"-"&dteMth&"-"&dteDay
strDate2 = dteYear&""&dteMth&""&dteDay
Dim objXLApp, objXLWb, objXLWs
Set objXLApp = CreateObject("Excel.Application")
Set objXLWb = objXLApp.Workbooks.Open("C:\Users\CuRrY\Desktop\"&strDate2&"\Agent Daily Disposition "&strDate2&".xls")
objXLApp.Application.Visible = True
'start excell
Set objXLWs = objXLWb.Sheets(1)
'objXLWs.Cells(Row, Column ).Value
With objXLWs
objXLWs.Cells(3, 1).Value = "Agent Name"
'objXLWs.Range("A3").Select
objXLWs.Range("A3").CurrentRegion.Select
'End With
as you can see i reached as far as CurrentRegion.Select but how to format selected cells into (medium 9) i've tried so much and failed
Thanks for any help
You can configure the CurrentRegion(which represents a Range object) through the SpecialCells Submethod. Although your conditions are specific to your xls sheet, you will still have to follow the formatting available through the specialcells() method properties. Also, by utilizing the currentregion property, the page assumes you have a xls header. So it is important to verify your table structure before trying to incorporate this property.
For instance:
Sub FillIn()
Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 _
= "=R[-1]C"
Range("A1").CurrentRegion.Value = Range("A1").CurrentRegion.Value
End Sub
View the available properties that can be applied to CurrentRegion -> Here
And the MSDN Article -> Here

get value of Checkbox in datagrid

I am working with windows application.
I have a datagrid in vb.net. Its first column is a checkbox. I want to know which checkboxes are checked and which are not.
My code is :
Dim dr As DataGridViewRow
For i = 0 To gdStudInfo.RowCount - 1
dr = gdStudInfo.Rows(i)
att = dr.Cells(0).Value.ToString()
If att.Equals("Present") Then
qry = "insert into Stu_Att_Detail values(" & id & "," & gdStudInfo.Rows(i).Cells(1).Value.ToString() & ",'" & dr.Cells(0).Value.ToString() & "')"
con.MyQuery(qry)
End If
Next
I am getting correct values for all checked check box, but it gets error when the checkbox is not checked.
What if you try this?
If Not String.IsNullOrEmpty(dr.Cells(0).Value) Then
'do stuff here
End If

Resources