RE: Cannot get code to work for API Save Dialog Box

I am not sure why you are not seeing the totals; however, there are a couple
of things you should look at. See notes below:

"Elleve" wrote:

I still cannot get the sum to display in the spread***. Here is my code:

Private Sub cmdExportSupportSchedule_Click()
Dim strFilter As String
Dim lngFlags As Long
Dim strDefaultDir As String
Dim varGetFileName As Variant

'Set filter to show only Excel spreadsheets
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)")
'Hides the Read Only Check Box on the Dialog box
lngFlags = ahtOFN_HIDEREADONLY
'Get the File Name To Save
strDefaultDir = "c:\"
varGetFileName = ahtCommonFileOpenSave( _
OpenFile:=False, _
InitialDir:=strDefaultDir, _
Filter:=strFilter, _
FileName:=strDefaultFileName, _
Flags:=lngFlags, _
DialogTitle:="Save Report")
Me.Repaint
If varGetFileName <> "" Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qrySupportScheduleUnionqry1and2", varGetFileName, True
End If

'Open Excel
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.
'On Error GoTo LoadAdjustedActuals_Err
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
?? Your workbook will not have the work*** name Actuals_res_export. I am
suprised you are not getting an error. If you want a specific name for a
work***, there are two places it can be done. One would be in the
TransferSpread*** above, you would give it a name by using the Range
argument of the TransferSpread***. The other would be to name it after you
have opened the workbook. It will open to the first ***, so you can name
it there:
xl***.Name = "WhatEverYouWant"

xlBook.Worksheets("Actuals_res_export").Activate

' Format output
With xl***
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(Str(intX))
strRightRange = "S" & Trim(Str(intX))
For Each cell In xl***.Range(strLeftRange, strRightRange)
cell.Font.Size = 10
cell.Font.Name = "Arial"
cell.Font.Bold = True
?? conLightBlue is a constant I set in my app to make the cell background
light bue. Here are the constants I set up because I never can remember all
the color numbers:
Const conLightGray As Long = 12632256
Const conLightBlue As Long = 16777164
Const conLightYellow As Long = 10092543

cell.Interior.Color = conLightBlue
cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)"
Next
Next intX
End With

'Formulas to add each column of amount
With xl***
.Cells(25, 6).Formula = "=sum(F2:F24)"
.Cells(25, 7).Formula = "=sum(G2:G24)"
.Cells(25, 8).Formula = "=sum(H2:H24)"
.Cells(25, 9).Formula = "=sum(I2:I24)"
End With

'Done and save
xlBook.Save
xlBook.Close
If blnExcelWasNotRunning = True Then
xlApp.Quit
Else
xlApp.DisplayAlerts = True
xlApp.Interactive = True
xlApp.ScreenUpdating = True
End If

Set xl*** = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

End Sub

*****************************************

As for the module I created this:

' Declare necessary API routines:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd
As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As
Long

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

Sub CreateNew***(xlApp As Object, xlBook As Object, xl*** As Object)
'Create a new work***
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activate
Set xl*** = xlBook.Active***
xl***.Name = strChartName
End Sub

What should I do to make it work?

"Klatuu" wrote:

Which column is it you want to enter the data in?

And for your next lesson :)
Okay, Here are some samples.


First, here is how you open an Excel Spread*** for Automation:
'Open Excel
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.
On Error GoTo LoadAdjustedActuals_Err
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
xlBook.Worksheets("Actuals_res_export").Activate
*******************
The above code uses this code. The code below should go it it's own module
just like you did for the Common Dialog API. I call mine modExcelRoutines

Option Compare Database
Option Explicit

' Declare necessary API routines:
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

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
***********************
Here is a formatting example
With xl***
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xl***.Range(strLeftRange, strRightRange)
cell.Font.Size = 10
cell.Font.Name = "Arial"
cell.Font.Bold = True
cell.Interior.Color = conLightBlue
cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)"
Next
Next intX
*********************************
Here is putting in formulas. You could use the Excel Sum function for your
totals
With xl***
.Cells(30, 2).Formula = "=+B29"
.Cells(30, 3).Formula = "=+B30+C29"
.Cells(30, 4).Formula = "=+C30+D29"
.Cells(30, 5).Formula = "=+D30+E29"
.Cells(30, 6).Formula = "=+E30+F29"
.Cells(30, 7).Formula = "=+F30+G29"
.Cells(30, 8).Formula = "=+G30+H29"
.Cells(30, 9).Formula = "=+H30+I29"
.Cells(30, 10).Formula = "=+I30+J29"
.Cells(30, 11).Formula = "=+J30+K29"
.Cells(30, 12).Formula = "=+K30+L29"
.Cells(30, 13).Formula = "=+L30+M29"
End With
*******************
Here's how you create a new work***
Sub CreateNew***(xlApp As Object, xlBook As Object, xl*** As Object)
'Create a new work***
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activate
Set xl*** = xlBook.Active***
xl***.Name = strChartName
End Sub
***************************
Then, once you are done:
xlBook.Save
xlBook.Close
If blnExcelWasNotRunning = True Then
xlApp.Quit
Else
xlApp.DisplayAlerts = True
xlApp.Interactive = True
xlApp.ScreenUpdating = True
End If
Set xl*** = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

.