Listbox and Transferring Records

W

Wuelf

Hi,
Just up front I have no formal training in access or coding. So the attached
Db might give some of you pro's a heart attack :)
I have a form with two listboxes the user can choose employees from the
first listbox and up to two additional inductions in the second listbox.
The crosstab queries for the employees and the static inductions works fine
(I think) but I don't know how to add the information from the second listbox
and crosstab query into the excell report.
If possible could someone have a look at the attached DB and see what I need
to do in the forms coding to allow this to work as it should .... thanks in
adavnce

http://www.bestsharing.com/files/ms00168197/Inductions.zip.html
 
S

SteveS

Hi,

It took a while to understand what you are trying to do, but I think I
finally got it.

First some suggestions:

In the main database window, click on TOOLS/OPTIONS/GENERAL and uncheck
"Track Name Autocorrect Info". this is a known cause of database corruption.

In the IDE, select TOOLS/OPTIONS/EDITOR and uncheck "Auto Syntax Check" and
check "Require Variable Declaration"
At the top of every code module you should have these two lines:

Option Compare Database
Option Explicit


After making some changes, saving and doing a few Compact and Repairs, the
code to limit "ListInduction" to two selection stopped working. I had to
modify the code like this:

'******************
Private Sub ListInduction_Click()
Dim intCurrentrow As Integer
If Me!ListInduction.ItemsSelected.Count = 3 Then
intCurrentrow = Me!ListInduction.ListIndex + 1 '<=
Me!ListInduction.Selected(intCurrentrow) = False
End If
End Sub
'******************



Here is the revised code for the "Report" button:
(watch for line wrap)

'################
Private Sub butReport_Click()
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim Path As String
Dim lngRows As Long

Dim vItm As Variant
Dim ColsToHide As Integer
Dim ColRow As String
Dim sCH As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryManningSheetInduction")
'Me.Visible = False

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
lngRows = rst.RecordCount

Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Manning
Sheet.xls")
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("Sheet1")
objBook.Windows(1).Visible = True

With objSheet
.Rows("11:11").Copy
If lngRows < 24 Then
.Range(.Rows(12), .Rows(34)).Insert
Else
.Range(.Rows(12), .Rows(lngRows) + 5).Insert
End If
.Range("a11").CopyFromRecordset rst
.Range("a11").Select

'74 = ascii "J"
sCH = 74
'loop thru selected items in ListInduction
For Each vItm In Me!ListInduction.ItemsSelected
sCH = sCH + 1
ColRow = Chr(sCH) & "9"
.Range(ColRow).Value = Format(Me!ListInduction.ItemData(vItm),
">") 'Should be from the query
Next vItm

'hide unused column(s)
ColsToHide = 2 - Me!ListInduction.ItemsSelected.Count
Select Case ColsToHide
Case 2
.Columns("K:L").EntireColumn.Hidden = True
Case 1
.Columns("L").EntireColumn.Hidden = True
End Select

.Range("A8").cancelcopy
End With

rst.Close
'show Excel
objApp.Visible = True
'clean up
Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing

DoCmd.Close acForm, "Manning Sheet", acSaveNo
End Sub
'###############

HTH
 
W

Wuelf

Thanks Steve that fixed the columns and heading issue much appreciated, are
you able to assist with the query issue. I can't get the gathered information
to combine into the excel report? cheers
 
S

SteveS

I don't understand what you mean by the query issue. I looked at the
"Inductions" list box, but I don't know what info you want transfered to the
Excel spreadsheet.

In looking at the tables, employee names are stored in two tables and there are
fields S1 - S5 in two tables. Before you get much farther, you should normalize
your tables.


Steve S.
 
E

eos

AUTO-REPLY From George Levitt

Please allow this to confirm a system receipt of your e-mail.

I am out of the office until Wednesday morning (1/12/05) and will not be
reviewing or responding to email or voicemail until that time.

I look forward to replying to your message on Wednesday.

Thanks and warmest regards, George
 
Top