Excel/Access VB Problem

[Wiz0fBaud]

Hey All-
I was handed a prexisting project and I want to make it bettter, there are some quirks in the code and some of it I can fix, some I can't.

This one for example I can't...

We have a button that when you click it, it calculates some values, and then prints it in on a graph in excel.

Anyway, when you don't close excel using File/Quit and just close using the X and try and run the command again by clicking the button, I get the error Method 'Worksheets' of object '_Global' failed.

Can anyone suggest to me as to what the problem could be and any possible resolutions?

 

[Elysium]

Wiz,

You need to see if you already have Excel running before you take any actions. Otherwise, you'll get that error. Here's some code to help you out:

Const CSIDL_DESKTOP = &H0
Const CSIDL_PROGRAMS = &H2
Const CSIDL_CONTROLS = &H3
Const CSIDL_PRINTERS = &H4
Const CSIDL_PERSONAL = &H5
Const CSIDL_FAVORITES = &H6
Const CSIDL_STARTUP = &H7
Const CSIDL_RECENT = &H8
Const CSIDL_SENDTO = &H9
Const CSIDL_BITBUCKET = &HA
Const CSIDL_STARTMENU = &HB
Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_DRIVES = &H11
Const CSIDL_NETWORK = &H12
Const CSIDL_NETHOOD = &H13
Const CSIDL_FONTS = &H14
Const CSIDL_TEMPLATES = &H15
Const MAX_PATH = 260
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Public Function IsAppRunning(ByVal strAppName As String, _
        Optional fActivate As Boolean) As Boolean
    Dim lngH As Long, strClassName As String
    Dim lngX As Long, lngTmp As Long
    Const WM_USER = 1024
    On Local Error GoTo IsAppRunning_Err
    IsAppRunning = False
    Select Case LCase$(strAppName)
        Case "excel":       strClassName = "XLMain"
        Case "word":        strClassName = "OpusApp"
        Case "access":      strClassName = "OMain"
        Case "powerpoint95": strClassName = "PP7FrameClass"
        Case "powerpoint97": strClassName = "PP97FrameClass"
        Case "notepad":     strClassName = "NOTEPAD"
        Case "paintbrush":  strClassName = "pbParent"
        Case "wordpad":     strClassName = "WordPadClass"
        Case Else:          strClassName = vbNullString
    End Select
    
    If strClassName = "" Then
        lngH = apiFindWindow(vbNullString, strAppName)
    Else
        lngH = apiFindWindow(strClassName, vbNullString)
    End If
    If lngH <> 0 Then
        apiSendMessage lngH, WM_USER + 18, 0, 0
        lngX = apiIsIconic(lngH)
        If lngX <> 0 Then
            lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
        End If
        If fActivate Then
            lngTmp = apiSetForegroundWindow(lngH)
        End If
        IsAppRunning = True
    End If
IsAppRunning_Exit:
    Exit Function
IsAppRunning_Err:
    IsAppRunning = False
    Resume IsAppRunning_Exit
End Function

I didn't write this and I can't remember who did. So, I can't give the proper credit. However, it works just fine and will help out.

Regards,



Randy

 

[havoc00]

This code checks to see if the app is running, but how can you kill it if it was running? so you don't get
Method 'Worksheets' of object '_Global' failed.

 

[RoyVidar]

Seing the code might help. What you're up against is most likely unqualified referencing of Excel objects, see Excel automation fails second time code runs.

Testing for a "valid" instance of Excel, can also be done with:

[tt]on error resume next
set xl=getobject(,"excel.application")
if err.number<>0 then
err.clear
' no instance of excel found... create one
set xl=createobject("excel.application")
ir err.number<>0 then
' oups - no excel installed???
exit sub
end if
end if
on error goto <your errorhandler>[/tt]

- this will perhaps not help in this situation, one need to prevent the problem from happening, and that is addressed in the link provided...

Roy-Vidar

 

[havoc00]

This is the module I was handed down.


Sub Test2()
Dim rst As ADODB.Recordset

Dim appROneHours As Excel.Application
Dim wkbROneHours As Excel.Workbook
Dim TaskArray(1 To 12) As Variant

TaskArray(1) = "01 - Design"
TaskArray(2) = "02 - Code Generation"
TaskArray(3) = "03 - Configuration Mgmt"
TaskArray(4) = "04 - Cold Testing"
TaskArray(5) = "05 - Hot Testing"
TaskArray(6) = "06 - Requirements Management"
TaskArray(7) = "07 - Planning/Tracking"
TaskArray(8) = "08 - SQA"
TaskArray(9) = "09 - Peer Reviews"
TaskArray(10) = "10 - Installation Labor"
TaskArray(11) = "11 - Shipboard Testing"
TaskArray(12) = "12 - Supplier Agreement"

Set rst = New ADODB.Recordset
rst.Open "releases", CurrentProject.Connection, adOpenStatic

Set appROneHours = CreateObject("Excel.Application")
appROneHours.Application.Workbooks.Add
Set wkbROneHours = appROneHours.Application.ActiveWorkbook

With wkbROneHours
If rst.RecordCount >= 3 Then
For C = 1 To rst.RecordCount - 2
wkbROneHours.Worksheets.Add After:=.Worksheets(.Worksheets.Count)
Next C
End If


For R = 1 To rst.RecordCount
strRelNum = R
With .Worksheets(R)
rst.Find "ID = " & R
.name = rst.Fields("release")
.Cells(1, 2) = .name
For T = 1 To 12
strCriteria = TaskArray(T)
.Cells(T + 2, 3) = DSum("[Hours]", "[AllTasks]", "[Task] = """ & strCriteria & """ AND [Release] = """ & strRelNum & """")
.Cells(T + 2, 5) = FormatCurrency(DSum("[payrate] * [Hours]", "[AllTasks]", "[Task] = """ & strCriteria & """ AND [Release] = """ & strRelNum & """"), 2)
.Cells(T + 2, 4) = DSum("[""" & strCriteria & "h""]", "[PredictedValues]", "[release] = """ & strRelNum & """")
.Cells(T + 2, 6) = FormatCurrency(DSum("[""" & strCriteria & "f""]", "[PredictedValues]", "[release] = """ & strRelNum & """"))
If IsEmpty(.Cells(T + 2, 3)) = True Then
.Cells(T + 2, 3).Value = 0
End If
If IsEmpty(.Cells(T + 2, 5)) = True Then
.Cells(T + 2, 5).Value = FormatCurrency(0)
End If
Next T
End With
Next R

With .Worksheets(.Worksheets.Count)
.name = "MCM Totals"
.Cells(1, 2) = .name
For T = 1 To 12
strCriteria = TaskArray(T)
.Cells(T + 2, 3) = DSum("[Hours]", "[AllTasks]", "[Task] = """ & strCriteria & """")
.Cells(T + 2, 5) = FormatCurrency(DSum("[payrate] * [Hours]", "[AllTasks]", "[Task] = """ & strCriteria & """"), 2)
.Cells(T + 2, 4) = DSum("[""" & strCriteria & "h""]", "[PredictedValues]")
.Cells(T + 2, 6) = FormatCurrency(DSum("[""" & strCriteria & "f""]", "[PredictedValues]"))
If IsEmpty(.Cells(T + 2, 3)) = True Then
.Cells(T + 2, 3).Value = 0
End If
If IsEmpty(.Cells(T + 2, 5)) = True Then
.Cells(T + 2, 5).Value = FormatCurrency(0)
End If
Next T
End With



For W = 1 To .Worksheets.Count
With .Worksheets(W)
Set rngC = .Range("C3:C14")
Set rngD = .Range("D314")
Set rngE = .Range("E3:E14")
Set rngF = .Range("F3:F14")
.Cells(2, 2) = "Task"
.Cells(2, 3) = "Hours"
.Cells(2, 4) = "Predicted Hours"
.Cells(2, 5) = "Funds"
.Cells(2, 6) = "Predicted Funds"
.Range("B1").Font.Size = 18
.Range("B1:F2").Font.Bold = True
.Range("B2:F2").Interior.Color = RGB(200, 200, 200)
.Range("B2:B14").ColumnWidth = 23
rngC.ColumnWidth = 10.75
rngD.ColumnWidth = 14.86
rngE.ColumnWidth = 11
rngF.ColumnWidth = 15.15
.Cells(3, 2) = "Design"
.Cells(4, 2) = "Code Generation"
.Cells(5, 2) = "Configuration Mgmt."
.Cells(6, 2) = "Cold Testing"
.Cells(7, 2) = "Hot Testing"
.Cells(8, 2) = "Requirements Management"
.Cells(9, 2) = "Planning/Tracking"
.Cells(10, 2) = "SQA"
.Cells(11, 2) = "Peer Reviews"
.Cells(12, 2) = "Installation Labor"
.Cells(13, 2) = "Shipboard Testing"
.Cells(14, 2) = "Supplier Agreement"
.Cells(15, 3) = WorksheetFunction.Sum(rngC)
.Cells(15, 4) = WorksheetFunction.Sum(rngD)
.Cells(15, 5) = FormatCurrency(WorksheetFunction.Sum(rngE))
.Cells(15, 6) = FormatCurrency(WorksheetFunction.Sum(rngF))
.Range("C15:F15").Borders.Item(xlEdgeTop).Color = RGB(0, 0, 0)
.Range("C15:F15").Borders.Item(xlEdgeTop).Weight = xlMedium
End With
.Charts.Add After:=Worksheets(W)
.ActiveChart.ChartType = xlColumnClustered
.ActiveChart.SeriesCollection.Add Worksheets(W).Range("B214")
.ActiveChart.HasLegend = True
.ActiveChart.HasDataTable = False
.ActiveChart.HasTitle = False
.ActiveChart.name = .Worksheets(W).name & " Hours"
.ActiveChart.PlotArea.Interior.Color = RGB(200, 180, 180)
.ActiveChart.Axes(xlCategory).TickLabels.Orientation = 45
.ActiveChart.Axes(xlCategory).TickLabelSpacing = 1
.ActiveChart.SeriesCollection(1).Interior.Color = RGB(0, 100, 0)
.ActiveChart.SeriesCollection(2).Interior.Color = RGB(100, 0, 100)
.Charts.Add Before:=Worksheets(W)
.ActiveChart.ChartType = xlColumnClustered
.ActiveChart.SeriesCollection.Add Worksheets(W).Range("E2:F14")
.ActiveChart.HasLegend = False
.ActiveChart.HasDataTable = False
.ActiveChart.HasTitle = False
.ActiveChart.name = .Worksheets(W).name & " Funds"
.ActiveChart.PlotArea.Interior.Color = RGB(200, 180, 180)
.ActiveChart.SeriesCollection(1).Interior.Color = RGB(0, 155, 0)
.ActiveChart.Axes(xlCategory).TickLabels.Orientation = 45
.ActiveChart.Axes(xlCategory).TickLabelSpacing = 1
.ActiveChart.Axes(xlCategory).CategoryNames = Worksheets(W).Range("B3:B14")
Next W
End With

appROneHours.Visible = True
rst.Close
Set appROneHours = Nothing
Set wkbROneHours = Nothing
End Sub

 

[RoyVidar]

Some things:

Since appROneHours is you excel application object, I don't think it is necessary to use it in the referencing, and these lines:

[tt]appROneHours.Application.Workbooks.Add
Set wkbROneHours = appROneHours.Application.ActiveWorkbook[/tt]

is also implicit, try:

[tt]Set wkbROneHours = appROneHours.Workbooks.Add[/tt]

FormatCurrency is an excel function, and I think it would need qualifying (possible also isempty, or is that VBA?)

appROneHours.FormatCurrency(...

None of the range objects are declared!!! Use option explicit as the second line of EVERY module - this is probably creating another instance of Excel.

Usage of with blocks also sometimes create anomalities in automation, but work on the qualifying/declaratins first, and have it compile (does it compile now?)

Roy-Vidar

 

[PHV]

Another implicit instantiation of excel:
.ActiveChart.Axes(xlCategory).CategoryNames = [highlight]Worksheets(W)[/highlight].Range("B3:B14")


Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244