Hi Dave:
Could you please see what is wrong; the file is on my
Desktop:Actuals_rez_export.xls
Thanks,
Dan
________________
SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10
Option Compare Database
Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
"SetForegroundWindow" (ByVal Hwnd As Long) As Long
Private Declare Function apiShowWindow Lib "user32" Alias _
"ShowWindow" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function apiIsIconic Lib "user32" Alias _
"IsIconic" (ByVal Hwnd As Long) As Long
Private Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, _
ByVal lpWindow As String) As Long
Private Declare Function apiSendMessage Lib "user32" Alias _
"SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal _
wParam As Long, lParam As Long) As Long
Sub Command0_Click()
Dim xlApp As Object 'Application Object
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object
On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("Excel.Application")
Else
DetectExcel
End If
Err.Clear ' Clear Err object in case error occurred.
'Set Error Trapping back on
'On Error GoTo Err_Command0_Click
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
Set xlSheet = xlBook.Worksheets("Actuals_res_export")
xlSheet.Cells(30, 13).Formula = "=+L30+M29"
xlBook.Save
xlBook.Close
If blnExcelWasNotRunning = True Then
xlApp.Quit
Else
xlApp.DisplayAlerts = True
xlApp.Interactive = True
xlApp.ScreenUpdating = True
End If
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
'Err_Command0_Click:
'MsgBox Err.Description
End Sub
Sub DetectExcel()
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim Hwnd As Long
' If Excel is running this API call returns its handle.
'Hwnd = FindWindow("XLMAIN", 0)
'If Hwnd = 0 Then ' 0 means Excel not running.
'Exit Sub
'Else
' Excel is running so use the SendMessage API
' function to enter it in the Running Object Table.
'SendMessage Hwnd, WM_USER + 18, 0, 0
'End If
End Sub
Function fIsAppRunning(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 fIsAppRunning_Err
fIsAppRunning = False
Select Case LCase$(strAppName)
Case "excel": strClassName = "Actuals_res_export"
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
fIsAppRunning = True
End If
fIsAppRunning_Exit:
Exit Function
fIsAppRunning_Err:
fIsAppRunning = False
Resume fIsAppRunning_Exit
Thanks,
Dan
D said:
Hi Dave:
I have 'passed' all the issues, but the file cannot be found; please check
the file name.....error..
Should the file be open?
Thanks,
Dan
Klatuu said:
Sorry iforgot about that part
download it here:
http://www.mvps.org/access/api/api0007.htm
--
Dave Hargis, Microsoft Access MVP
D said:
Yes I did and passed; thanks Dave!
Now I get Sub or Function not defined here: FindWindow
Thanks,
Dan
:
That is because it is setting the error handling to go to that label. You
can either remove the line or if you put an error handler in your procedure,
change it to the name of your label for the error handler.
--
Dave Hargis, Microsoft Access MVP
:
Thanks Dave!
Here I get label not defined: On Error GoTo CreateWorkbook_Error
Thanks,
Dan
:
Yes you can.
If you have any problems, post back. As I said, I pulled this together from
a couple of different sources, so I will not guarantee it is bug free.
--
Dave Hargis, Microsoft Access MVP
:
Thanks a LOT Dave!!
Can I put this 'behind' a button into an Acces form??
Thanks again,
Dan
:
D
I missed one line in my last post.
Just before xlbook.close
You need
xlbook.Save
--
Dave Hargis, Microsoft Access MVP
:
Hi Dave:
Would you have an example?
Thanks,
Dan
:
You will have to use automation to do this. That is, create an excel object
and use VBA to set the formula property of the cell with the formula.
--
Dave Hargis, Microsoft Access MVP
:
Hi:
I have some calculations in a query; one of them is:to_adj_GL_CEQ:
([adj'd_gl_ceq]+[adj'd_optex_ceq])*[Me_fx_rate]
Can you please tell me how can I export this formula into Excel? - not the
result - formula itself? is that possible?
Thanks,
Dan
