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!

  • 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!

VB & Excel Question....

Status
Not open for further replies.

eves

Programmer
Jul 29, 2001
18
0
0
SG
Hello to all...

I'm having problems with getting some things to work in excel...

I have a database containing information about staff information, department information, sub-department information and course information.

I need to print these information grouped by department and sub-department which i need to do in excel.

The printing format is something like this
============================================
|Name1|Name2|Name3|
|--------|--------|--------|
course1|*****|--------|--------|
course2|--------|*****|*****|
course3|*****|*****|--------|

============================================

Name1 have to go for 2 training(course1 & course3)
Name2 have to go for 2 training(Course2 & course3)
Name3 have to go for 1 training(course2)

*(Asterix) - denotes that the cell is shaded...
and the - (Dash) means that the cell is blank...

I know i need to tell the program to run through the database to get the courses that the specific staff is undergoing and then i need to search in Excel the staff name and get the location of it and then the course name, get the location... with these information i then get the column and row location to shade the appropriate cell... but i don't know how to do all this. I got the idea but i dunno the codes for it...

Anyway...i used copyfromrecordset method to get my data from the Db to excel...

Please help me with this... THanks A lot...=)
I'm in real need for this...
 
This may be sort of relevant It shows how excel can be manipulated from VB usin an excel object. It's an application I wrote to extract data from two tables (client and project) in Access and put it in an excel spreadsheet. For each client there could be several projects. I wanted the client details as a header row and below a list of the client's projects. Then the next client etc.

I hope it gives you some ideas. You may need to check the Microsoft Excel Object 8.0 library in project references in VB6. Play around with it, I'm sure there are many ways to manipulate the cells from withing VB e.g.

xlSheet.Cells(2, 15).Formula

Here's the code.
(This form just has a single command button but the original also had a progress bar because there were so many records)

Option Explicit

Private cn As Connection

Private Sub cmdOutput_Click()

Dim client As String
Dim project As String
Dim rsClient As ADODB.Recordset
Dim rsProject As ADODB.Recordset
Dim rsCount As ADODB.Recordset
Dim projectSQL As String 'complete SQL state ment with where clause value (x)
Dim x As String ' this will pick up the client form the recordset rsClient
Dim row As Integer


'Excel Stuff
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

client = "Select * From Client_Details"
Set rsClient = cn.Execute(client)

'unfinished SQL statement to find project associated with a given client

project = "SELECT ProjectID, Name, Description From Project WHERE client_No = "

'By using nested loops, can group all projects under the heading of the Client

Do Until rsClient.EOF 'outer loop - find client

Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
x = rsClient!client_No

projectSQL = project & "'" & x & "';" 'finish SQL Where clause by inserting the current client_No from rsClient
Set rsProject = cn.Execute(projectSQL) 'recordset of projects for this Client

'Print the data to the excel file. This first list will be column headings
xlSheet.Cells(1, 1).Value = "client_No"
xlSheet.Cells(1, 2).Value = "Company"
xlSheet.Cells(1, 3).Value = "contact Title"
xlSheet.Cells(1, 4).Value = "contact Forename"
xlSheet.Cells(1, 5).Value = "contact Surname"
xlSheet.Cells(1, 6).Value = "Address 1"
xlSheet.Cells(1, 7).Value = "Address 2"
xlSheet.Cells(1, 8).Value = "Address 3"
xlSheet.Cells(1, 9).Value = "Town"
xlSheet.Cells(1, 10).Value = "County"
xlSheet.Cells(1, 11).Value = "Postcode1"
xlSheet.Cells(1, 12).Value = "Postcode2"
xlSheet.Cells(1, 13).Value = "Tel"
xlSheet.Cells(1, 14).Value = "Fax"
xlSheet.Cells(1, 15).Value = "Email"

xlSheet.Cells(2, 1).Value = rsclient![client_No]
xlSheet.Cells(2, 2).Value = rsclient![Company]
xlSheet.Cells(2, 3).Value = rsclient![contact Title]
xlSheet.Cells(2, 4).Value = rsclient![contact_Forename]
xlSheet.Cells(2, 5).Value = rsclient![contact_Surname]
xlSheet.Cells(2, 6).Value = rsclient![Address1]
xlSheet.Cells(2, 7).Value = rsclient![Address2]
xlSheet.Cells(2, 8).Value = rsclient![Address3]
xlSheet.Cells(2, 9).Value = rsclient![Town]
xlSheet.Cells(2, 10).Value = rsclient![County]
xlSheet.Cells(2, 11).Value = rsclient![Postcode1]
xlSheet.Cells(2, 12).Value = rsclient![Postcode2]
xlSheet.Cells(2, 13).Value = rsclient![Tel]
xlSheet.Cells(2, 14).Value = rsclient![Fax]
xlSheet.Cells(2, 15).Value = rsclient!


'Inner loop finding projects associated with the client_No in the outer loop
'first print Project table heading for spreadsheet

xlSheet.Cells(4, 1).Value = "Project ID"
xlSheet.Cells(4, 2).Value = "Project Name"
xlSheet.Cells(4, 3).Value ="Project Description"
xlSheet.Cells(4, 4).Value = "Comments"
row = 5
' the row which is the starting point for listing ptojects on the spreadsheet, in this case start listing projects in row 5

'now begin inner project loop
Do Until rsProject.EOF 'iterate through all projects associated with client_No.

'print the project details and move on to next project(if any) associated with client_No

xlSheet.Cells(row, 1).Value = rsProject![ProjectID]
xlSheet.Cells(row, 2).Value = rsProject![Name]
xlSheet.Cells(row, 3).Value = rsProject![Description]
rsProject.MoveNext
row = row + 1 ' next project on next row
Loop


rsClient.MoveNext

Loop ' outer loop - move to next client

MsgBox ("Output complete")


xlSheet.SaveAs "EB_" & x & ".xls"
'quit Excel
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

cn.Close
Set rsEBNo = Nothing
Set rsProject = Nothing


End Sub




Private Sub Form_Load()

Set cn = New ADODB.Connection
cn.ConnectionString = "DSN=ENT;"
cn.Open


End Sub


 
Ok...i've managed to somehow get a rough coding on the function that i wanted... but the problem now is that the loops are not really working when it should... Can anyone look at my codes and tell me where i went wrong with the loops... i'm confused with my own loops... =)

THanks to all...

On Error Resume Next

Set Srs = New ADODB.Recordset
Set Crs = New ADODB.Recordset
Set SCrs = New ADODB.Recordset

Srs.Open "SELECT Staff.FullName FROM Staff", cnn2, adOpenStatic, adLockOptimistic

Dim xlCnt As Integer
Dim CurRec As String
Dim SresU As String
Dim SresLocal As String
Dim Crcnt As Integer
Dim cresu As String
Dim creslocal As String
Dim curcrs As String

For xlCnt = 3 To msxlws.Columns.Count - 1

CurRec = Srs!FullName
SCrs.Open "SELECT Course.Crs FROM Staff, Course WHERE Course.StaffID = Staff.StaffID AND FullName = '" & CurRec & "'", cnn2, adOpenStatic, adLockOptimistic

SresU = msxlws.Cells(7, xlCnt).Find(CurRec)
SresLocal = Replace(msxlws.Cells(7, xlCnt).Address, "$", "", , , vbTextCompare)

If IsNumeric(Right(Left$(SresLocal, 2), 1)) = False Then

SresLocal = Left$(SresLocal, 2)

Else

SresLocal = Left$(SresLocal, 1)

End If

If Not SresU = "" Then

MsgBox "Found " & SresU & " At location " & SresLocal

For Crcnt = 8 To msxlws.Rows.Count - 1

curcrs = SCrs!Crs
cresu = msxlws.Cells(Crcnt, 2).Find(curcrs)
creslocal = Replace(msxlws.Cells(4 + xlCnt, 2).Address, "$", "", , , vbTextCompare)

If IsNumeric(Right(creslocal, 2)) = True Then

creslocal = Right(creslocal, 2)

Else

creslocal = Right(creslocal, 1)

End If

If Not cresu = "" Then

MsgBox "Found " & cresu & " At location " & creslocal
msxlws.Cells(creslocal, SresLocal).Interior.Pattern = xlPatternCrissCross
'Exit Sub

End If

SCrs.MoveNext

If SCrs.EOF Then
Exit Sub
End If

Next

End If

Srs.MoveNext

If Srs.EOF Then

Exit Sub

End If

Next
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top