A Microsoft Office (Excel, Word) forum. OfficeFrustration

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » OfficeFrustration forum » Microsoft Access » Using Forms
Site Map Home Register Authors List Search Today's Posts Mark Forums Read  

Cannot get code to work for API Save Dialog Box



 
 
Thread Tools Display Modes
  #21  
Old February 16th, 2006, 06:28 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

In response to your previous two posts regarding formatting and totaling.

You won't be able to do that with with the query or with the
TransferSpreadsheet. It can be done, but it is pretty advanced. What you
will have to do is use VBA to open the spreadsheet after you export it as an
object. You can then use VBA with Excel properties and methods to do the
formatting and totaling. If you want to have a go at it, post back and I
will send you some sample code that shows how that can be done.

As to this question, I don't think I have a complete grasp of how your query
is constructed. How about sending me the SQL for your query so I can have a
look at it. You can do that by opening the query in design mode, switch to
SQL view and copy it into a post.

"Elleve" wrote:

Another thing just came up... The fourth column in the subform is basically
the same as the third column, the only difference is that I put in some extra
criteria if else that is calculated in the query. However I want the user to
be allowed to change this amount. For each line in the subform the user can
edit the amount based on his/her judgment. I set the default value to the
fourth column, but this made each row in the subform change to the same
amount entered. I want to save this individual amount instead of what was
there before (replace) and calculate the new total for that specific
form/subform. Later I will use each total from about 18 records in a form
that calculates some of these totals. Is this possible to do?

"Klatuu" wrote:

If using the list box in a query criteria is a problem, there is an easy way
to address that problem. You can use user defined functions in queries. So,
write a function that will return one of the columns based on a parameter you
pass it. Then use that function in your query. It would be something like
this:

Public Function GetListColumn(lngCol as Long) as String
GetListColumn = Forms!MyFormName!ListName.Column(lngCol)
End Function


"Elleve" wrote:

Instead of exporting the form, is it possible to do a printscreen of the form
and output it to word/excel/etc? I want the output to be exactly like on the
form, which contains total amount as well.

"Klatuu" wrote:

I assume that you are not really naming your listbox listbox. Don't use
Access reserved named to name your objects, but I can't say that is the
problem.

Is this line actually in your criteria?
[Affil]]=[Forms]![frmName]![listbox].column(1)
Seems it would throw a syntax error in the query builder.
I have not used a listbox as a query parameter, but I have used combo boxes
as parameters in queries that are tied to union queries, so that part should
be good.


"Elleve" wrote:

That seemed to be more difficult than I thought. The reason is that the
subform is based on a union query (of two other queries). I tried putting
parameters in both the underlying queries, but I got into trouble. I need
four parameters to get the information needed, two comboboxes and two from a
listbox. As for the comboboxes I put in the following that seems to work:
[Month]=[Forms]!frmName]![comboMonth]
[Year]=[Forms]!frmName]![comboYear]

The listbox creates the problem:
[Unit]=[Forms]![frmName]![listbox].column(0)
[Affil]]=[Forms]![frmName]![listbox].column(1)

The error message says "undefined function listbox..."

I tried putting this code into the expression builder when clicking the
button to open the form/subform itself, but that gave me the same error
message....

What do you suggest I do?

"Klatuu" wrote:

You will need to create a parameter query that will include only the data in
your sub form.

"Elleve" wrote:

I managed to get the open dialog box by this code:

Private Sub cmdExportSupportSchedule_Click()

Dim strFilter As String
Dim lngFlags As Long
Dim strDefaultDir As String
Dim strSaveFileName As String

'Set filter to show only Excel spreadsheets
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
'Hides the Read Only Check Box on the Dialog box
lngFlags = ahtOFN_HIDEREADONLY

'Get the File Name To Save
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False,
Filter:=strFilter, Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
If strSaveFileName = "" Then 'User Clicked CANCEL
Exit Sub
End If

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qrySubformUnionQuery1and2", strSaveFileName, True

End Sub

My problem now is that it is not exporting the correct information because
it is taking information from the query only. I want it to export only what
I have in the form w/subform currently. The main form is based on what is in
the listbox and the subform is based on qrySupportScheduleUnionqry1and2 that
is linked to the main form by four criterias of month, year, BU, and Affil.

How do I get only the information selected?


"Klatuu" wrote:

First thing is, Private Sub End Sub is not a module, it is a procedure.
There are two types of procedures. A Sub is called to execute code but does
not return any value to the calling procedure. You usually use a Sub for
events or for tasks that may be called from more than one place. Basically,
if you have a procedure you may call from more than one form or form multiple
places in a form, you should put that code in a Sub. If it is called from
more than one form or report, then it should be in a Standard module. If it
is only used by one form, then it can go in the General section of the form
module.

A Function is another type of procedure. It is used to perform some
evaluation or calculation and returns a value to the calling procedure. The
same rules as for Subs applys on how to use it .

A module is a collection of Subs and or Functions. Forms and reports can
have, but are not required to have modules. The code you put in your form
and report events are in the form or report module. A Standard module is a
collection of code that is usually called from forms, reports, or other
modules. For example, the code you downloaded for the API is a module. I
usually group procedures into modules that have something in common. I have
one module that is nothing more that date functions - Calculating the number
of working days between two dates, Finding the Friday of a given week, etc.

As to your code below. There are two things that need attention. First
there is a problem with this line:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"frmSupportScheduleGLMainForm", varGetFileName, True

The next issue is declaring variables. Although not required, it is best to
establish the habit of always declaring and typing your variables. You can
always tell what data type my variables are by the prefix on the name. For
example var is for a Variant data type, str is for a String data type, lng is
Long Integer, etc. The reason you did not see the variable declarations the
code I sent is because they were declared at the module level because I need
them in more than this sub. Read up on varialbe Scoping.

So, add these lines right after the Sub statement:

Dim strFilter as String
Dim lngFlags as Long
Dim strDefaultDir as String
Dim varGetFileName as Variant

And, good luck!

frmSupportScheduleGLMainForm is a form name. What you want here is the name
of the table or query you are exporting.
"Elleve" wrote:

You're great in your feedback and speediness. I seem to be on the right
track now, I only have one more question regarding modules as I have never
used them before - how do you set up the module? Is it like private sub-end
sub?

By the way, here is the code I have for the event itself:

Private Sub cmdExportSupportSchedule_Click()
'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(ahtOFN_OVERWRITEPROMPT,
strDefaultDir, "Excel Spreadsheets (*.xls) *.xls", , "xls", varGetFileName,
"Import Adjusted Actuals", , True)
Me.Repaint
If varGetFileName = "" Then 'User Clicked CANCEL
GoTo LoadAdjustedActuals_Exit
End If
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"frmSupportScheduleGLMainForm", varGetFileName, True
End Sub

Does this look like it would work?

"Klatuu" wrote:

Not stupid questions at all. See answers below in your post:

"Elleve" wrote:

Will I have to include the comboboxes in the coding? For your information,
No, what I sent was just an example. You can change it as necessary to use
the values you need for your situation. If they come from a list box, just
reference the column in the list box you need to use.

the listbox I mentioned last time consist of two columns that are contain a
relationship from a separate query. They are neccessary in order to pick up
the correct information. This is done by
=[Forms]![frmSupportScheduleMain]![List54].[column](0). Why can't I just
export what is at the current form to excel since this information is already
specified?
You can. This code does not do the export, it only returns a path and file
where you want to open or save the data. If you are exporting to Excel, you
would use varGetFileName as the File argument in your TransferSpreadsheet.


Also, as for the coding you provided me - where exactly do I input this?
Under the click event? Will I still need to keep the downloaded coding from
If you want this to happen as the result of a click event, then that would
be the place to put it.
You still need the downloaded code. It should be kept by itself in a
Standard module. Mine is named modCommonDialog. The sample I provided
calles the API routines in modCommonDialog.
the website as is or make changes to it. I apologize if I ask stupid
Do Not make changes to it. Calling APIs is very powerful, but also somewhat
dangerous. If you make changes in the downloaded code, you could get some
very weird unexpected results.

API stands for Application Program Interface. What you are doing is making
calls to DLL's in the Windows operating system. If you pass bad values, bad
things can happen. Don't let this discourage you. The alternative is an
ActiveX control. ActiveX controls are not that easy to deal with. This API
is very useful. My current application uses it about 20 different places.

questions, but that coding just got me lost.


"Klatuu" wrote:

First, don't put anything in the module you downloaded. It could cause
problems. Here is an example of how I use that exact same API module:

'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

strCurrMonth = Me.cboPeriod.Column(1)
strCurrYear = Me.txtCurrYear
'Get the File Name To Save
strDefaultDir = "\\rsltx1-bm01\busmgmt\Vought " & strCurrYear & "\" &
strCurrYear _
& " Actuals\" & strCurrMonth & "\"
varGetFileName = "Vought Invoice " & strCurrMonth & " " & strCurrYear &
".xls"

varGetFileName = ahtCommonFileOpenSave(ahtOFN_OVERWRITEPROMPT, _
strDefaultDir, "Excel Spreadsheets (*.xls) *.xls", , _
"xls", varGetFileName, "Import Adjusted Actuals", , True)
Me.Repaint
If varGetFileName = "" Then 'User Clicked CANCEL
GoTo LoadAdjustedActuals_Exit
End If


"Elleve" wrote:

I have an access database (2000) where I want the user to click on a button
to save the current form (with subform) to excel. This event will open a
dialog box so the user will be able to save.

I have seen several links to http://www.mvps.org/access/api/api0001.htm when
creating dialog box to save. However, I cannot get this code to work. What
am I doing wrong?

I copied the code exactly like shown on the website and then started making
my changes to make it work. I did not understand how to put in my own
coding, if this should be a substitute for testit or my own "on click" or
function. Here is what I did by deleting the function testit():

Private Sub cmdTest_Click()
Dim strFilter As String
Dim strSaveFileName As String
strFilter = ahtAddFilterItem(mystrFilter, "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False,
Filter:=strFilter, Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
End Sub

I keep getting the error message: "only comments may appear after end sub,
end function or end property."

  #22  
Old February 16th, 2006, 06:51 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

As to the first part, yes I would like to have a go at it to format and total
the output.

As to the second part, my form (no longer subform needed) is based on a
union query that looks like this:
SELECT *
FROM qrySubform1Settle
UNION ALL SELECT *
FROM qrySubform2NotSettle;

Here's the coding from the two underlying queries:

First Query:
SELECT qryGLbalance.Unit, qryGLbalance.Affiliate, qryTotCum.Expr1 AS
[Month], qryTotCum.Expr2 AS [Year], Max(IIf(InStr(1,[Line
Descr],"settle")0,[Line Descr],"Beginning Balance")) AS Description,
qryTotCum.Cumm, Sum(IIf(InStr(1,[Line Descr],"settle")0,[Amount],0)) AS
Activity, [Activity]+[Cumm] AS EB, 0 AS PreApproved, 0 AS Approved
FROM qryTotCum RIGHT JOIN qryGLbalance ON (qryTotCum.Affiliate =
qryGLbalance.Affiliate) AND (qryTotCum.Unit = qryGLbalance.Unit)
GROUP BY qryGLbalance.Unit, qryGLbalance.Affiliate, qryTotCum.Expr1,
qryTotCum.Expr2, qryTotCum.Cumm
HAVING (((qryGLbalance.Unit)=GetListColumn(0)) AND
((qryGLbalance.Affiliate)=GetListColumn(1)) AND
((qryTotCum.Expr1)=[Forms]![frmMain]![comboMonth]) AND
((qryTotCum.Expr2)=[Forms]![frmMain]![comboYear]));

Second Query:
SELECT qryTotCum.Unit, qryTotCum.Affiliate, qryTotCum.Expr1 AS [Month],
qryTotCum.Expr2 AS [Year], qryTotCum.[Line Descr], 0 AS BB, qryTotCum.Amount,
qryTotCum.Amount AS EBNotSettle, IIf(InStr(1,[Line
Descr],"suspense")0,0,[EBNotSettle]) AS ApprovedMinusSuspense,
IIf(InStr(1,[Line Descr],"return")0,0,[ApprovedMinusSuspense]) AS Approved
FROM qryGLbalance RIGHT JOIN qryTotCum ON (qryGLbalance.Unit =
qryTotCum.Unit) AND (qryGLbalance.Affiliate = qryTotCum.Affiliate)
GROUP BY qryTotCum.Unit, qryTotCum.Affiliate, qryTotCum.Expr1,
qryTotCum.Expr2, qryTotCum.[Line Descr], qryTotCum.Amount
HAVING (((qryTotCum.Unit)=GetListColumn(0)) AND
((qryTotCum.Affiliate)=GetListColumn(1)) AND
((qryTotCum.Expr1)=[Forms]![frmMain]![comboMonth]) AND
((qryTotCum.Expr2)=[Forms]![frmMain]![comboYear]) AND ((InStr(1,[Line
Descr],"settle"))="0"));

Let me know what other information you need.

"Klatuu" wrote:

In response to your previous two posts regarding formatting and totaling.

You won't be able to do that with with the query or with the
TransferSpreadsheet. It can be done, but it is pretty advanced. What you
will have to do is use VBA to open the spreadsheet after you export it as an
object. You can then use VBA with Excel properties and methods to do the
formatting and totaling. If you want to have a go at it, post back and I
will send you some sample code that shows how that can be done.

As to this question, I don't think I have a complete grasp of how your query
is constructed. How about sending me the SQL for your query so I can have a
look at it. You can do that by opening the query in design mode, switch to
SQL view and copy it into a post.

"Elleve" wrote:

Another thing just came up... The fourth column in the subform is basically
the same as the third column, the only difference is that I put in some extra
criteria if else that is calculated in the query. However I want the user to
be allowed to change this amount. For each line in the subform the user can
edit the amount based on his/her judgment. I set the default value to the
fourth column, but this made each row in the subform change to the same
amount entered. I want to save this individual amount instead of what was
there before (replace) and calculate the new total for that specific
form/subform. Later I will use each total from about 18 records in a form
that calculates some of these totals. Is this possible to do?

"Klatuu" wrote:

If using the list box in a query criteria is a problem, there is an easy way
to address that problem. You can use user defined functions in queries. So,
write a function that will return one of the columns based on a parameter you
pass it. Then use that function in your query. It would be something like
this:

Public Function GetListColumn(lngCol as Long) as String
GetListColumn = Forms!MyFormName!ListName.Column(lngCol)
End Function


"Elleve" wrote:

Instead of exporting the form, is it possible to do a printscreen of the form
and output it to word/excel/etc? I want the output to be exactly like on the
form, which contains total amount as well.

"Klatuu" wrote:

I assume that you are not really naming your listbox listbox. Don't use
Access reserved named to name your objects, but I can't say that is the
problem.

Is this line actually in your criteria?
[Affil]]=[Forms]![frmName]![listbox].column(1)
Seems it would throw a syntax error in the query builder.
I have not used a listbox as a query parameter, but I have used combo boxes
as parameters in queries that are tied to union queries, so that part should
be good.


"Elleve" wrote:

That seemed to be more difficult than I thought. The reason is that the
subform is based on a union query (of two other queries). I tried putting
parameters in both the underlying queries, but I got into trouble. I need
four parameters to get the information needed, two comboboxes and two from a
listbox. As for the comboboxes I put in the following that seems to work:
[Month]=[Forms]!frmName]![comboMonth]
[Year]=[Forms]!frmName]![comboYear]

The listbox creates the problem:
[Unit]=[Forms]![frmName]![listbox].column(0)
[Affil]]=[Forms]![frmName]![listbox].column(1)

The error message says "undefined function listbox..."

I tried putting this code into the expression builder when clicking the
button to open the form/subform itself, but that gave me the same error
message....

What do you suggest I do?

"Klatuu" wrote:

You will need to create a parameter query that will include only the data in
your sub form.

"Elleve" wrote:

I managed to get the open dialog box by this code:

Private Sub cmdExportSupportSchedule_Click()

Dim strFilter As String
Dim lngFlags As Long
Dim strDefaultDir As String
Dim strSaveFileName As String

'Set filter to show only Excel spreadsheets
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
'Hides the Read Only Check Box on the Dialog box
lngFlags = ahtOFN_HIDEREADONLY

'Get the File Name To Save
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False,
Filter:=strFilter, Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
If strSaveFileName = "" Then 'User Clicked CANCEL
Exit Sub
End If

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qrySubformUnionQuery1and2", strSaveFileName, True

End Sub

My problem now is that it is not exporting the correct information because
it is taking information from the query only. I want it to export only what
I have in the form w/subform currently. The main form is based on what is in
the listbox and the subform is based on qrySupportScheduleUnionqry1and2 that
is linked to the main form by four criterias of month, year, BU, and Affil.

How do I get only the information selected?


"Klatuu" wrote:

First thing is, Private Sub End Sub is not a module, it is a procedure.
There are two types of procedures. A Sub is called to execute code but does
not return any value to the calling procedure. You usually use a Sub for
events or for tasks that may be called from more than one place. Basically,
if you have a procedure you may call from more than one form or form multiple
places in a form, you should put that code in a Sub. If it is called from
more than one form or report, then it should be in a Standard module. If it
is only used by one form, then it can go in the General section of the form
module.

A Function is another type of procedure. It is used to perform some
evaluation or calculation and returns a value to the calling procedure. The
same rules as for Subs applys on how to use it .

A module is a collection of Subs and or Functions. Forms and reports can
have, but are not required to have modules. The code you put in your form
and report events are in the form or report module. A Standard module is a
collection of code that is usually called from forms, reports, or other
modules. For example, the code you downloaded for the API is a module. I
usually group procedures into modules that have something in common. I have
one module that is nothing more that date functions - Calculating the number
of working days between two dates, Finding the Friday of a given week, etc.

As to your code below. There are two things that need attention. First
there is a problem with this line:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"frmSupportScheduleGLMainForm", varGetFileName, True

The next issue is declaring variables. Although not required, it is best to
establish the habit of always declaring and typing your variables. You can
always tell what data type my variables are by the prefix on the name. For
example var is for a Variant data type, str is for a String data type, lng is
Long Integer, etc. The reason you did not see the variable declarations the
code I sent is because they were declared at the module level because I need
them in more than this sub. Read up on varialbe Scoping.

So, add these lines right after the Sub statement:

Dim strFilter as String
Dim lngFlags as Long
Dim strDefaultDir as String
Dim varGetFileName as Variant

And, good luck!

frmSupportScheduleGLMainForm is a form name. What you want here is the name
of the table or query you are exporting.
"Elleve" wrote:

You're great in your feedback and speediness. I seem to be on the right
track now, I only have one more question regarding modules as I have never
used them before - how do you set up the module? Is it like private sub-end
sub?

By the way, here is the code I have for the event itself:

Private Sub cmdExportSupportSchedule_Click()
'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(ahtOFN_OVERWRITEPROMPT,
strDefaultDir, "Excel Spreadsheets (*.xls) *.xls", , "xls", varGetFileName,
"Import Adjusted Actuals", , True)
Me.Repaint
If varGetFileName = "" Then 'User Clicked CANCEL
GoTo LoadAdjustedActuals_Exit
End If
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"frmSupportScheduleGLMainForm", varGetFileName, True
End Sub

Does this look like it would work?

"Klatuu" wrote:

Not stupid questions at all. See answers below in your post:

"Elleve" wrote:

Will I have to include the comboboxes in the coding? For your information,
No, what I sent was just an example. You can change it as necessary to use
the values you need for your situation. If they come from a list box, just
reference the column in the list box you need to use.

the listbox I mentioned last time consist of two columns that are contain a
relationship from a separate query. They are neccessary in order to pick up
the correct information. This is done by
=[Forms]![frmSupportScheduleMain]![List54].[column](0). Why can't I just
export what is at the current form to excel since this information is already
specified?
You can. This code does not do the export, it only returns a path and file
where you want to open or save the data. If you are exporting to Excel, you
would use varGetFileName as the File argument in your TransferSpreadsheet.


Also, as for the coding you provided me - where exactly do I input this?
Under the click event? Will I still need to keep the downloaded coding from
If you want this to happen as the result of a click event, then that would
be the place to put it.
You still need the downloaded code. It should be kept by itself in a
Standard module. Mine is named modCommonDialog. The sample I provided
calles the API routines in modCommonDialog.
the website as is or make changes to it. I apologize if I ask stupid
Do Not make changes to it. Calling APIs is very powerful, but also somewhat
dangerous. If you make changes in the downloaded code, you could get some
very weird unexpected results.

API stands for Application Program Interface. What you are doing is making
calls to DLL's in the Windows operating system. If you pass bad values, bad
things can happen. Don't let this discourage you. The alternative is an
ActiveX control. ActiveX controls are not that easy to deal with. This API
is very useful. My current application uses it about 20 different places.

questions, but that coding just got me lost.


"Klatuu" wrote:

First, don't put anything in the module you downloaded. It could cause
problems. Here is an example of how I use that exact same API module:

'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

strCurrMonth = Me.cboPeriod.Column(1)
strCurrYear = Me.txtCurrYear
'Get the File Name To Save
strDefaultDir = "\\rsltx1-bm01\busmgmt\Vought " & strCurrYear & "\" &
strCurrYear _
& " Actuals\" & strCurrMonth & "\"
varGetFileName = "Vought Invoice " & strCurrMonth & " " & strCurrYear &
".xls"

varGetFileName = ahtCommonFileOpenSave(ahtOFN_OVERWRITEPROMPT, _
strDefaultDir, "Excel Spreadsheets (*.xls) *.xls", , _
"xls", varGetFileName, "Import Adjusted Actuals", , True)
Me.Repaint
If varGetFileName = "" Then 'User Clicked CANCEL
GoTo LoadAdjustedActuals_Exit
End If


"Elleve" wrote:

I have an access database (2000) where I want the user to click on a button
to save the current form (with subform) to excel. This event will open a
dialog box so the user will be able to save.

I have seen several links to http://www.mvps.org/access/api/api0001.htm when
creating dialog box to save. However, I cannot get this code to work. What
am I doing wrong?

I copied the code exactly like shown on the website and then started making
my changes to make it work. I did not understand how to put in my own
coding, if this should be a substitute for testit or my own "on click" or
function. Here is what I did by deleting the function testit():

Private Sub cmdTest_Click()
Dim strFilter As String
Dim strSaveFileName As String
strFilter = ahtAddFilterItem(mystrFilter, "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False,
Filter:=strFilter, Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
End Sub

I keep getting the error message: "only comments may appear after end sub,
end function or end property."

  #23  
Old February 16th, 2006, 07:31 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

  #24  
Old February 16th, 2006, 07:45 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

The column I want to edit data in is for qrySupporScheduleNotSettle under
'Approved' (last column on the right).

Thanks, I'll keep working on my lessons for now

"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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

  #25  
Old February 16th, 2006, 10:07 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

I still cannot get the sum to display in the spreadsheet. 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)
xlBook.Worksheets("Actuals_res_export").Activate

' Format output
With xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(Str(intX))
strRightRange = "S" & Trim(Str(intX))
For Each cell In xlSheet.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
End With

'Formulas to add each column of amount
With xlSheet
.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 xlSheet = 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 CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

  #26  
Old February 17th, 2006, 04:04 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default 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 spreadsheet. 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 worksheet name Actuals_res_export. I am
suprised you are not getting an error. If you want a specific name for a
worksheet, there are two places it can be done. One would be in the
TransferSpreadsheet above, you would give it a name by using the Range
argument of the TransferSpreadsheet. The other would be to name it after you
have opened the workbook. It will open to the first sheet, so you can name
it the
xlSheet.Name = "WhatEverYouWant"

xlBook.Worksheets("Actuals_res_export").Activate

' Format output
With xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(Str(intX))
strRightRange = "S" & Trim(Str(intX))
For Each cell In xlSheet.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 xlSheet
.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 xlSheet = 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 CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

  #27  
Old February 17th, 2006, 04:28 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

I made the corrections and called the excel sheet "Support Schedule" instead.

Did I maybe put the coding in the wrong place? It seems to be not catching
up on the formulas at all, and not the coloring either. Maybe it does not
recognize the with statements at all? Excel only displays what was there
originally before we added on the format and total code.

"Klatuu" wrote:

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 spreadsheet. 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 worksheet name Actuals_res_export. I am
suprised you are not getting an error. If you want a specific name for a
worksheet, there are two places it can be done. One would be in the
TransferSpreadsheet above, you would give it a name by using the Range
argument of the TransferSpreadsheet. The other would be to name it after you
have opened the workbook. It will open to the first sheet, so you can name
it the
xlSheet.Name = "WhatEverYouWant"

xlBook.Worksheets("Actuals_res_export").Activate

' Format output
With xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(Str(intX))
strRightRange = "S" & Trim(Str(intX))
For Each cell In xlSheet.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 xlSheet
.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 xlSheet = 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 CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

  #28  
Old February 17th, 2006, 04:35 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

A couple of suggestions.
Add error handling to your code so if an error occurs, it will be trapped
and you will know what is not working.

Comment out these 3 lines:
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Then set a breakpoint on this line and step through your code. After each
line executes, switch to the Excel sheet to see what happened.
xlSheet.Name = "WhatEverYouWant"

"Elleve" wrote:

I made the corrections and called the excel sheet "Support Schedule" instead.

Did I maybe put the coding in the wrong place? It seems to be not catching
up on the formulas at all, and not the coloring either. Maybe it does not
recognize the with statements at all? Excel only displays what was there
originally before we added on the format and total code.

"Klatuu" wrote:

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 spreadsheet. 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 worksheet name Actuals_res_export. I am
suprised you are not getting an error. If you want a specific name for a
worksheet, there are two places it can be done. One would be in the
TransferSpreadsheet above, you would give it a name by using the Range
argument of the TransferSpreadsheet. The other would be to name it after you
have opened the workbook. It will open to the first sheet, so you can name
it the
xlSheet.Name = "WhatEverYouWant"

xlBook.Worksheets("Actuals_res_export").Activate

' Format output
With xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(Str(intX))
strRightRange = "S" & Trim(Str(intX))
For Each cell In xlSheet.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 xlSheet
.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 xlSheet = 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 CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

  #29  
Old February 17th, 2006, 05:17 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

Okay, so now the code in that section looks like this:

DoEvents
'xlApp.DisplayAlerts = False
'xlApp.Interactive = False
'xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
xlSheet.Name = "SupportSchedule"
xlBook.Worksheets("Support Schedule").Activate

However, there is no excelsheet called supportschedule created. Maybe I'm
not understanding correctly what this sheet is doing. Is it taking over for
the excelsheet named what the user entered? Is it hidden in the background?

"Klatuu" wrote:

A couple of suggestions.
Add error handling to your code so if an error occurs, it will be trapped
and you will know what is not working.

Comment out these 3 lines:
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Then set a breakpoint on this line and step through your code. After each
line executes, switch to the Excel sheet to see what happened.
xlSheet.Name = "WhatEverYouWant"

"Elleve" wrote:

I made the corrections and called the excel sheet "Support Schedule" instead.

Did I maybe put the coding in the wrong place? It seems to be not catching
up on the formulas at all, and not the coloring either. Maybe it does not
recognize the with statements at all? Excel only displays what was there
originally before we added on the format and total code.

"Klatuu" wrote:

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 spreadsheet. 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 worksheet name Actuals_res_export. I am
suprised you are not getting an error. If you want a specific name for a
worksheet, there are two places it can be done. One would be in the
TransferSpreadsheet above, you would give it a name by using the Range
argument of the TransferSpreadsheet. The other would be to name it after you
have opened the workbook. It will open to the first sheet, so you can name
it the
xlSheet.Name = "WhatEverYouWant"

xlBook.Worksheets("Actuals_res_export").Activate

' Format output
With xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(Str(intX))
strRightRange = "S" & Trim(Str(intX))
For Each cell In xlSheet.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 xlSheet
.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 xlSheet = 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 CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

  #30  
Old February 17th, 2006, 05:24 PM posted to microsoft.public.access.forms
external usenet poster
 
Posts: n/a
Default Cannot get code to work for API Save Dialog Box

Left something out, you need this:

'Activate the sheet for totals
xlBook.Worksheets(1).Activate
Set xlSheet = xlBook.ActiveSheet
xlSheet.Name = Me.cboOffering & " Labor Total"


"Elleve" wrote:

Okay, so now the code in that section looks like this:

DoEvents
'xlApp.DisplayAlerts = False
'xlApp.Interactive = False
'xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
xlSheet.Name = "SupportSchedule"
xlBook.Worksheets("Support Schedule").Activate

However, there is no excelsheet called supportschedule created. Maybe I'm
not understanding correctly what this sheet is doing. Is it taking over for
the excelsheet named what the user entered? Is it hidden in the background?

"Klatuu" wrote:

A couple of suggestions.
Add error handling to your code so if an error occurs, it will be trapped
and you will know what is not working.

Comment out these 3 lines:
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Then set a breakpoint on this line and step through your code. After each
line executes, switch to the Excel sheet to see what happened.
xlSheet.Name = "WhatEverYouWant"

"Elleve" wrote:

I made the corrections and called the excel sheet "Support Schedule" instead.

Did I maybe put the coding in the wrong place? It seems to be not catching
up on the formulas at all, and not the coloring either. Maybe it does not
recognize the with statements at all? Excel only displays what was there
originally before we added on the format and total code.

"Klatuu" wrote:

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 spreadsheet. 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 worksheet name Actuals_res_export. I am
suprised you are not getting an error. If you want a specific name for a
worksheet, there are two places it can be done. One would be in the
TransferSpreadsheet above, you would give it a name by using the Range
argument of the TransferSpreadsheet. The other would be to name it after you
have opened the workbook. It will open to the first sheet, so you can name
it the
xlSheet.Name = "WhatEverYouWant"

xlBook.Worksheets("Actuals_res_export").Activate

' Format output
With xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(Str(intX))
strRightRange = "S" & Trim(Str(intX))
For Each cell In xlSheet.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 xlSheet
.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 xlSheet = 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 CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 Spreadsheet 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 xlSheet
For intX = 2 To lngItmCount + 1
strLeftRange = "C" & Trim(str(intX))
strRightRange = "S" & Trim(str(intX))
For Each cell In xlSheet.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 xlSheet
.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 worksheet
Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object)
'Create a new worksheet
xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count)
xlBook.Worksheets(xlBook.Worksheets.Count).Activat e
Set xlSheet = xlBook.ActiveSheet
xlSheet.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 xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Visio Shortcuts [email protected] Visio 1 December 29th, 2006 12:28 AM
Save work automatically Ramon Niese General Discussions 2 November 7th, 2005 05:59 PM
Make Change Case in Excel a format rather than formula Kevin Worksheet Functions 1 March 18th, 2005 09:53 PM
Open File and Save As don't work David Evans Powerpoint 8 June 4th, 2004 04:25 PM
Two versions again-language issue Otto Setup, Installing & Configuration 3 May 28th, 2004 04:57 AM


All times are GMT +1. The time now is 10:23 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 OfficeFrustration.
The comments are property of their posters.