F
FGM
The program is at the bottom of my questions. Thank you for any help you can
give. Windows 2000 Office 2002
What I do is take Access data and copy/send it to an excel spreadsheet and
creating different worksheets for different data. Make charts for the data.
When it gets to this sub it is sending a group of averages for different
access files to the worksheet. That part works. The only part that seems to
have trouble is when it tries to count the rows in the worksheet that I add
in this sub.
I set the a global variables MxlApp and MxlBook in another sub that works
through a couple other subs before getting to this one.
it is this part that works sometimes and does not another
intFiles = xlSht.Range(Range("A4"), Range("A4").End(xlDown)).Count / 6
I have also tried other ways
intFiles = xlSht.Range(Selection, Selection.End(xlDown)).Count / 6
intFiles = MxlBook.Sheets("All-Averages").Range(Range("A4"),
Range("A4").End(xlDown)).Count/6
Public Sub TransferLN_AveragesALL()
'transfers all the Averages of the filenames selected to one worksheet
'and charts the averages for each group of LN's
Dim xlSht As Excel.Worksheet
' DAO and other variables
Dim db As DAO.Database
Dim rst1 As Recordset
Dim intRows As Integer
Dim strChartName As String
Dim strChartTitle As String
Dim strChartY As String
Dim strSQL As String
Dim intFiles As Integer
Dim i As Integer 'loop
Dim strRange As String
Const conRANGE = "A4"
On Error GoTo Err_TransferLN_AveragesAll
DoCmd.SetWarnings False
DoCmd.SetWarnings True
Set db = CurrentDb
strSQL = "SELECT * FROM qryLN_Levels_Avg_All ORDER BY LN_Level ASC,
FileName ASC "
Set rst1 = db.OpenRecordset(strSQL)
Set xlSht = MxlBook.Worksheets.Add
xlSht.Name = "All-Averages"
xlSht.Activate
'========Header
With xlSht
.Range("A2").Value = "FileName"
.Range("B2").Value = "LN_Level"
.Range("C2").Value = "12.5Hz"
.Range("D2").Value = "16Hz"
.Range("E2").Value = "20Hz"
.Range("F2").Value = "25Hz"
.Range("G2").Value = "31.5Hz"
.Range("H2").Value = "40Hz"
.Range("I2").Value = "50Hz"
.Range("J2").Value = "63Hz"
.Range("K2").Value = "80Hz"
.Range("L2").Value = "100Hz"
.Range("M2").Value = "125Hz"
.Range("N2").Value = "160Hz"
.Range("O2").Value = "200Hz"
.Range("P2").Value = "250Hz"
.Range("Q2").Value = "315Hz"
.Range("R2").Value = "400Hz"
.Range("S2").Value = "500Hz"
.Range("T2").Value = "630Hz"
.Range("U2").Value = "800Hz"
.Range("V2").Value = "1KHz"
.Range("W2").Value = "1.25KHz"
.Range("X2").Value = "16KHz"
.Range("Y2").Value = "2KHz"
.Range("Z2").Value = "2.5KHz"
.Range("AA2").Value = "3.15KHz"
.Range("AB2").Value = "4KHz"
.Range("AC2").Value = "5KHz"
.Range("AD2").Value = "6.3KHz"
.Range("AE2").Value = "8KHz"
.Range("AF2").Value = "10KHz"
.Range("AG2").Value = "12.5KHz"
.Range("AH2").Value = "16KHz"
.Range("AI2").Value = "20KHz"
End With
With xlSht.Range("A2:AI2")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'++++++++++ END OF HEADER
xlSht.Range(conRANGE).CopyFromRecordset rst1
MxlBook.Save
rst1.Close
'For the Charts
xlSht.Range("A4").Select
intFiles = xlSht.Range(Range("A4"), Range("A4").End(xlDown)).Count / 6
'Next
'Do Charts for all 6 levels
intRows = 1
For i = 1 To 6
Select Case i
Case 1
strChartName = "C-Avg L01"
strChartTitle = "L01 Averages"
strChartY = "L1 dB"
Case 2
strChartName = "C-Avg L10"
strChartTitle = "L10 Averages"
strChartY = "L10 dB"
Case 3
strChartName = "C-Avg L50"
strChartTitle = "L50 Averages"
strChartY = "L50 dB"
Case 4
strChartName = "C-Avg L90"
strChartTitle = "L90 Averages"
strChartY = "L90 dB"
Case 5
strChartName = "C-Avg L95"
strChartTitle = "L95 Averages"
strChartY = "L95 dB"
Case 6
strChartName = "C-Avg L99"
strChartTitle = "L99 Averages"
strChartY = "L99 dB"
Case Else
strChartName = "C-Levels Combined"
strChartTitle = "L Levels Combined"
End Select
strRange = "A2:AI2,A" & intRows + 3 & ":AI" & intRows + 2 + intFiles
MxlBook.Charts.Add
MxlBook.ActiveChart.ApplyCustomType ChartType:=xlUserDefined,
TypeName:="LN824-third"
MxlBook.ActiveChart.SetSourceData
Source:=MxlBook.Sheets("All-Averages").Range(strRange) _
, PlotBy:=xlRows
MxlBook.ActiveChart.Location where:=xlLocationAsNewSheet,
Name:=strChartName
With MxlBook.ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = strChartTitle
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "1/3
Octave"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = strChartY
End With
MxlBook.ActiveChart.PlotArea.Select
intRows = intRows + intFiles
xlSht.Select
Next i
'====
MxlBook.Save
MxlBook.Close
MxlApp.Quit
Set MxlBook = Nothing
Set MxlApp = Nothing
Set xlSht = Nothing
MsgBox "Transfer Complete"
Exit Sub
Exit_TransferLN_AveragesAll:
MxlBook.Save
MxlBook.Close
MxlApp.Quit
Set MxlBook = Nothing
Set MxlApp = Nothing
Set xlSht = Nothing
MsgBox "Error in Transfer"
Exit Sub
Err_TransferLN_AveragesAll:
MsgBox Err.Description & " - Sub TransferLN_AveragesAll"
Resume Exit_TransferLN_AveragesAll
End Sub
give. Windows 2000 Office 2002
What I do is take Access data and copy/send it to an excel spreadsheet and
creating different worksheets for different data. Make charts for the data.
When it gets to this sub it is sending a group of averages for different
access files to the worksheet. That part works. The only part that seems to
have trouble is when it tries to count the rows in the worksheet that I add
in this sub.
I set the a global variables MxlApp and MxlBook in another sub that works
through a couple other subs before getting to this one.
it is this part that works sometimes and does not another
intFiles = xlSht.Range(Range("A4"), Range("A4").End(xlDown)).Count / 6
I have also tried other ways
intFiles = xlSht.Range(Selection, Selection.End(xlDown)).Count / 6
intFiles = MxlBook.Sheets("All-Averages").Range(Range("A4"),
Range("A4").End(xlDown)).Count/6
Public Sub TransferLN_AveragesALL()
'transfers all the Averages of the filenames selected to one worksheet
'and charts the averages for each group of LN's
Dim xlSht As Excel.Worksheet
' DAO and other variables
Dim db As DAO.Database
Dim rst1 As Recordset
Dim intRows As Integer
Dim strChartName As String
Dim strChartTitle As String
Dim strChartY As String
Dim strSQL As String
Dim intFiles As Integer
Dim i As Integer 'loop
Dim strRange As String
Const conRANGE = "A4"
On Error GoTo Err_TransferLN_AveragesAll
DoCmd.SetWarnings False
DoCmd.SetWarnings True
Set db = CurrentDb
strSQL = "SELECT * FROM qryLN_Levels_Avg_All ORDER BY LN_Level ASC,
FileName ASC "
Set rst1 = db.OpenRecordset(strSQL)
Set xlSht = MxlBook.Worksheets.Add
xlSht.Name = "All-Averages"
xlSht.Activate
'========Header
With xlSht
.Range("A2").Value = "FileName"
.Range("B2").Value = "LN_Level"
.Range("C2").Value = "12.5Hz"
.Range("D2").Value = "16Hz"
.Range("E2").Value = "20Hz"
.Range("F2").Value = "25Hz"
.Range("G2").Value = "31.5Hz"
.Range("H2").Value = "40Hz"
.Range("I2").Value = "50Hz"
.Range("J2").Value = "63Hz"
.Range("K2").Value = "80Hz"
.Range("L2").Value = "100Hz"
.Range("M2").Value = "125Hz"
.Range("N2").Value = "160Hz"
.Range("O2").Value = "200Hz"
.Range("P2").Value = "250Hz"
.Range("Q2").Value = "315Hz"
.Range("R2").Value = "400Hz"
.Range("S2").Value = "500Hz"
.Range("T2").Value = "630Hz"
.Range("U2").Value = "800Hz"
.Range("V2").Value = "1KHz"
.Range("W2").Value = "1.25KHz"
.Range("X2").Value = "16KHz"
.Range("Y2").Value = "2KHz"
.Range("Z2").Value = "2.5KHz"
.Range("AA2").Value = "3.15KHz"
.Range("AB2").Value = "4KHz"
.Range("AC2").Value = "5KHz"
.Range("AD2").Value = "6.3KHz"
.Range("AE2").Value = "8KHz"
.Range("AF2").Value = "10KHz"
.Range("AG2").Value = "12.5KHz"
.Range("AH2").Value = "16KHz"
.Range("AI2").Value = "20KHz"
End With
With xlSht.Range("A2:AI2")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'++++++++++ END OF HEADER
xlSht.Range(conRANGE).CopyFromRecordset rst1
MxlBook.Save
rst1.Close
'For the Charts
xlSht.Range("A4").Select
intFiles = xlSht.Range(Range("A4"), Range("A4").End(xlDown)).Count / 6
'Next
'Do Charts for all 6 levels
intRows = 1
For i = 1 To 6
Select Case i
Case 1
strChartName = "C-Avg L01"
strChartTitle = "L01 Averages"
strChartY = "L1 dB"
Case 2
strChartName = "C-Avg L10"
strChartTitle = "L10 Averages"
strChartY = "L10 dB"
Case 3
strChartName = "C-Avg L50"
strChartTitle = "L50 Averages"
strChartY = "L50 dB"
Case 4
strChartName = "C-Avg L90"
strChartTitle = "L90 Averages"
strChartY = "L90 dB"
Case 5
strChartName = "C-Avg L95"
strChartTitle = "L95 Averages"
strChartY = "L95 dB"
Case 6
strChartName = "C-Avg L99"
strChartTitle = "L99 Averages"
strChartY = "L99 dB"
Case Else
strChartName = "C-Levels Combined"
strChartTitle = "L Levels Combined"
End Select
strRange = "A2:AI2,A" & intRows + 3 & ":AI" & intRows + 2 + intFiles
MxlBook.Charts.Add
MxlBook.ActiveChart.ApplyCustomType ChartType:=xlUserDefined,
TypeName:="LN824-third"
MxlBook.ActiveChart.SetSourceData
Source:=MxlBook.Sheets("All-Averages").Range(strRange) _
, PlotBy:=xlRows
MxlBook.ActiveChart.Location where:=xlLocationAsNewSheet,
Name:=strChartName
With MxlBook.ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = strChartTitle
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "1/3
Octave"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = strChartY
End With
MxlBook.ActiveChart.PlotArea.Select
intRows = intRows + intFiles
xlSht.Select
Next i
'====
MxlBook.Save
MxlBook.Close
MxlApp.Quit
Set MxlBook = Nothing
Set MxlApp = Nothing
Set xlSht = Nothing
MsgBox "Transfer Complete"
Exit Sub
Exit_TransferLN_AveragesAll:
MxlBook.Save
MxlBook.Close
MxlApp.Quit
Set MxlBook = Nothing
Set MxlApp = Nothing
Set xlSht = Nothing
MsgBox "Error in Transfer"
Exit Sub
Err_TransferLN_AveragesAll:
MsgBox Err.Description & " - Sub TransferLN_AveragesAll"
Resume Exit_TransferLN_AveragesAll
End Sub