Executing MS Excel through MS Access vba

[andreas....@ny.frb.org]

Hello,

I am exporting a spreadsheet from an Access database and I want to
format the excel file. Thus, I have written to pieces of VBA code, one
in Access, one in Excel. Does anybody have any ideas on how to combine
them. I have looked up several solutions, yet have not found a workable
one.

The Access Code:
Sub Request_Export_Click()
Dim datestr As String

datestr = Me.File_Date

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "ACCOUNTS
In", "H:\HS Details " & datestr & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "ACCOUNTS
Out", "H:\HS Details " & datestr & ".xls"

End Sub

The Excel Code:
Sub format_worksheet()

Columns("a:a").ColumnWidth = 7.5
Columns("b:ao").ColumnWidth = 15

Cells.Select
With Selection
.Font.Name = "Arial"
.Font.Size = 8
End With

Range("a1:ao600").Select
With Selection
.WrapText = True
.ShrinkToFit = True
End With

Range("a1:ao1").Select
With Selection
.HorizontalAlignment = xlCenter
End With

End Sub

Thanks,

Andreas

[Klatuu]

You will need to do this in Access. You can manipulate the Excel object
model from Access, but the syntax will be a little different that if you are
actually in Excel. The code below is much more than you need, but you can
use it to copy the pieces you do need into your own code. The important part
when using automation between Access and Excel is how you open and close a
reference to Excel and how you refer to the Excel objects. If not done
correctly, it can create problems. So, enjoy (and post back if you need help
understanding any of this)

Sub Build_XL_Report(strOutPut As String)
Const conLightGray As Long = 12632256
Const conLightBlue As Long = 16777164
Const conLightYellow As Long = 10092543

Dim xlApp As Object 'Application Object
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object
Dim varGetFileName As Variant 'File Name with Full Path
Dim rstSCCB As Recordset 'Recordset to load data from
Dim rstItms As Recordset 'Recordset to load ITM Name in Header
Dim qdf As QueryDef 'Query def to load data
Dim lngItmCount As Long 'Number of ITMs in the RecordSet
Dim lngDetailCount As Long 'Number of Detail Data rows in the recordset
Dim intX As Integer 'Loop Counter
Dim strMonth As String 'Used to create a Short month name ie
January to Jan
Dim strCurrItm As String 'Hold the ITM Name to format Total cell
Dim lngRowCount As Long 'A loop counter that gives the current row
reference
Dim lngTotalPos As Long 'Used to format ITM Total cells
Dim strPrintArea As String 'Defines the print area for the sheet
Dim strTitleRows As String 'Defines the rows to print at the top of
each page
Dim strLeftRange As String 'Used to format range references
Dim strRightRange As String 'Used to format range references
Dim lngFirstDataRow As Long 'The first row with detail data
Dim lngLastDataRow As Long 'The last row with detail data
Dim blnExcelWasNotRunning As Boolean
Dim strDefaultDir 'Where to save spreadsheet
Dim strDefaultFileName 'Name to Save as
Dim lngFlags As Long 'Flags for common dialog
Dim strFilter As String 'File Display for Common Dialog
Dim strCurrMonth As String 'To create directory name for save
Dim strCurrYear As String 'To create directory name for save
Dim blnStopXl As Boolean 'Leave Open for Spreadsheet Version

On Error GoTo Build_XL_Report_ERR

DoCmd.Hourglass (True)
Me.txtStatus = "Updating Queries"
Me.txtStatus.Visible = True
'Fix the Queries so you dont have to be hand each month
Call FixSql("qselsccbactual", "actual_res_export")
Call FixSql("qselsccbactualtot", "actual_res_export")
Me.txtStatus = "Getting ITM Data"
Me.Repaint

'Set up the necessary objcts
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 Build_XL_Report_ERR
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Add

Me.txtStatus = "Building Workbook"
Me.Repaint

'Remove excess worksheets
Do While xlBook.Worksheets.Count > 1
xlApp.Worksheets(xlApp.Worksheets.Count).Delete
Loop
Set xlSheet = xlBook.ActiveSheet

'Build The Spreadsheet
'Build The Headers
Me.txtStatus = "Creating Headers"
Me.Repaint

strMonth = Left(Me.cboPeriod.Column(1), 3)
xlSheet.Name = Me.cboResource & " Hours " & strMonth & " YTD"
With xlSheet
.Cells(1, 1) = "ITM"
.Cells(1, 2) = Me.txtCurrYear & _
" Activity # Description"
.Cells(1, 3) = "Budget " & Me.txtCurrYear
.Cells(1, 4).Value = Me.txtCurrYear & " YTD Budget"
.Cells(1, 5) = "Actuals YTD"
.Cells(1, 6) = "Variance YTD"
.Cells(1, 7) = "TO GO"
.Cells(1, 8) = IIf(Me.cboPeriod >= 1, "JAN ACT", "JAN ETC")
.Cells(1, 9) = IIf(Me.cboPeriod >= 2, "FEB ACT", "FEB ETC")
.Cells(1, 10) = IIf(Me.cboPeriod >= 3, "MAR ACT", "MAR ETC")
.Cells(1, 11) = IIf(Me.cboPeriod >= 4, "APR ACT", "APR ETC")
.Cells(1, 12) = IIf(Me.cboPeriod >= 5, "MAY ACT", "MAY ETC")
.Cells(1, 13) = IIf(Me.cboPeriod >= 6, "JUN ACT", "JUN ETC")
.Cells(1, 14) = IIf(Me.cboPeriod >= 7, "JUL ACT", "JUL ETC")
.Cells(1, 15) = IIf(Me.cboPeriod >= 8, "AUG ACT", "AUG ETC")
.Cells(1, 16) = IIf(Me.cboPeriod >= 9, "SEP ACT", "SEP ETC")
.Cells(1, 17) = IIf(Me.cboPeriod >= 10, "OCT ACT", "OCT ETC")
.Cells(1, 18) = IIf(Me.cboPeriod >= 11, "NOV ACT", "NOV ETC")
.Cells(1, 19) = IIf(Me.cboPeriod >= 12, "DEC ACT", "DEC ETC")
End With
'Format Row 1
With xlSheet
For Each cell In xlSheet.Range("A1", "S1")
cell.Font.Size = 10
cell.Font.Name = "Arial"
cell.Font.Bold = True
cell.Interior.Color = conLightGray
cell.HorizontalAlignment = xlHAlignCenter
cell.WrapText = True
Next
.Cells(1, 2).HorizontalAlignment = xlHAlignLeft
.Columns("A").ColumnWidth = 9
.Columns("B").ColumnWidth = 39
.Columns("C:S").ColumnWidth = 9
.Rows(1).RowHeight = 25.5
End With

'Set Up Recordset for ITM Header data
Me.txtStatus = "Loading ITM Data"
Me.Repaint

Set qdf = CurrentDb.QueryDefs("qselSCCBhdr")
qdf.Parameters(0) = Me.cboResource
qdf.Parameters(1) = Me.cboPeriod
Set rstItms = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly)
'Be sure there are records to process
rstItms.MoveLast
rstItms.MoveFirst
lngItmCount = rstItms.RecordCount
If lngItmCount = 0 Then
MsgBox "No Data Found For This Report", vbInformation + vbOKOnly,
"Data Error"
GoTo Build_XL_Report_Exit
End If

'Load Header Data
xlSheet.Cells(2, 1).CopyFromRecordset rstItms
rstItms.Close
Set rstItms = Nothing
Set qdf = Nothing

'Format the ITM Name Cells
Me.txtStatus = "Formatting Headers"
Me.Repaint

With xlSheet
For Each cell In xlSheet.Range("A2", "A" & Trim(str(lngItmCount + 2)))
cell.Font.Size = 10
cell.Font.Name = "Arial"
cell.Font.Bold = True
cell.Interior.Color = conLightGray
cell.HorizontalAlignment = xlHAlignLeft
cell.WrapText = False
Next
End With

'Merge the ITM Cells
For intX = 2 To lngItmCount + 2
strLeftRange = "A" & Trim(str(intX)) & ":B" & Trim(str(intX))
xlSheet.Range(strLeftRange).MergeCells = True
Next intX

'Size the Blank Row
xlSheet.Rows(lngItmCount + 3).RowHeight = 30

'Format Header Area and put in formulas
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
'Do The Grand Total Row
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 = conLightYellow
cell.Formula = "= Grand"
cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)"
Next
End With

'Put Borders around the Header Area
With xlSheet.Range("A1", "S" & Trim(str(lngItmCount + 2)))
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Add Total to ITM Names
For intX = 2 To lngItmCount + 1
xlSheet.Cells(intX, 1) = "Grand Total " & xlSheet.Cells(intX, 1)
Next intX
xlSheet.Cells(intX, 1) = "Grand Total " & _
Me.cboResource & " HOURS"

'Copy the Header Row to the top of the Data Area
xlSheet.Range("A1:S1").Copy _
Destination:=xlSheet.Range("A" & Trim(str(intX + 2)))

'Load the Data
Me.txtStatus = "Loading Detail Data"
Me.Repaint

Set qdf = CurrentDb.QueryDefs("qselSCCBrpt")
qdf.Parameters(0) = Me.cboResource
qdf.Parameters(1) = Me.cboPeriod
Set rstSCCB = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly)
xlSheet.Cells(intX + 3, 1).CopyFromRecordset rstSCCB
lngDetailCount = rstSCCB.RecordCount
rstSCCB.Close
Set rstSCCB = Nothing
Set qdf = Nothing

'Put in the SubTotals
Me.txtStatus = "Creating Subtotals"
Me.Repaint

lngFirstDataRow = intX + 3
lngLastDataRow = lngFirstDataRow + lngItmCount + lngDetailCount
With xlSheet
.Range(.Cells(lngFirstDataRow - 1, 1), _
.Cells(lngLastDataRow, 19)).Subtotal groupBy:=1,
Function:=xlSum, _
totalList:=Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19)
End With

'Create Formulas and range names
For lngRowCount = lngFirstDataRow To lngLastDataRow
lngTotalPos = InStr(xlSheet.Cells(lngRowCount, 1), "Total")
If lngTotalPos = 0 Then 'Column S needs to be light yellow if not a
total row
xlSheet.Cells(lngRowCount, 5).Interior.Color = conLightYellow
xlSheet.Cells(lngRowCount, 6).Interior.Color = conLightYellow
Else
strCurrItm = Left(xlSheet.Cells(lngRowCount, 1), lngTotalPos - 2)
With xlSheet
.Range("C" & Trim(str(lngRowCount)) & ":S" & _
Trim(str(lngRowCount))).Name = strCurrItm
.Range("A" & Trim(str(lngRowCount)) & ":S" & _
Trim(str(lngRowCount))).Interior.Color = conLightGray
End With
End If
Next lngRowCount

'Clear the subtotals
xlSheet.Range("A:S").Copy
xlSheet.Range("A:S").PasteSpecial (xlPasteValues)
xlSheet.Range("A:S").RemoveSubtotal
xlSheet.Cells(1, 1).Select 'Removes the selection

'Set the Margins, Headers and Footers
Me.txtStatus = "Formating Worksheet"
Me.Repaint

strPrintArea = "A1:S" & Trim(str(lngLastDataRow))
strTitleRows = 1 & ":" & Trim(str(lngItmCount + 3))
With xlSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1
.CenterHeader = Me.txtCurrYear & " " & Me.cboResource _
& " Hours " & strMonth & " YTD"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xlApp.InchesToPoints(0)
.RightMargin = xlApp.InchesToPoints(0)
.TopMargin = xlApp.InchesToPoints(0.5)
.BottomMargin = xlApp.InchesToPoints(0.5)
.HeaderMargin = xlApp.InchesToPoints(0.25)
.FooterMargin = xlApp.InchesToPoints(0.25)
.PrintArea = strPrintArea
.PrintTitleRows = xlSheet.Rows(strTitleRows).Address
End With

'Format the Data Area
With xlSheet
strLeftRange = "A" & Trim(str(lngFirstDataRow))
strRightRange = "S" & Trim(str(lngLastDataRow))
For Each cell In xlSheet.Range(strLeftRange, strRightRange)
cell.Font.Size = 10
cell.Font.Name = "Arial"
cell.Font.Bold = True
cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)"
Next
End With

'Put Borders around the Data Area
With xlSheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Spreadsheet is complete - Save it

'Set up default path and file
strCurrYear = Me.txtCurrYear
strCurrMonth = Me.cboPeriod.Column(1)
strDefaultDir = "\\rsltx1-bm01\busmgmt\Vought " & strCurrYear & "\" &
strCurrYear _
& " Actuals\" & strCurrMonth & "\"
strDefaultFileName = Me.cboPeriod.Column(1) & _
IIf([Forms]![frmsccbrpt]![cboResource] = "SEL", _
" SCCB Report", " " & Me.cboResource & " Performance Report") &
".xls"
'Set filter to show only Excel spreadsheets
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)")
'Flags Hides the Read Only Check and Only allow existing files
lngFlags = ahtOFN_HIDEREADONLY Or ahtOFN_OVERWRITEPROMPT
'Call the Open File Dialog
varGetFileName = ahtCommonFileOpenSave( _
OpenFile:=False, _
InitialDir:=strDefaultDir, _
Filter:=strFilter, _
Filename:=strDefaultFileName, _
Flags:=lngFlags, _
DialogTitle:="Save Report")
If varGetFileName <> "" Then
xlBook.SaveAs Filename:=varGetFileName
Select Case strOutPut
Case "Print"
blnStopXl = True
xlSheet.PrintOut Copies:=1, Collate:=True
Case "PreView"
blnStopXl = True
xlApp.DisplayAlerts = True
xlApp.Interactive = True
xlApp.ScreenUpdating = True
xlApp.Visible = True
xlApp.WindowState = xlMaximized
xlSheet.PrintPreview
xlApp.Visible = False
Case "XL"
blnStopXl = False
xlApp.DisplayAlerts = True
xlApp.Interactive = True
xlApp.ScreenUpdating = True
xlApp.WindowState = xlMaximized
xlApp.Visible = True
End Select
End If
'Time to Go
Build_XL_Report_Exit:
Me.txtStatus.Visible = False
Me.Repaint

If blnStopXl Then
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 If
DoCmd.Hourglass (False)

Exit Sub

Build_XL_Report_ERR:
MsgBox (Err.Number & " - " & Err.Description)
blnStopXl = True
GoTo Build_XL_Report_Exit
End Sub

[BruceS]

Andreas,

Had a similar need just last week. You can open the spreadsheet and make
the format changes all from VBA. Here is my code, which works in A2K. Maybe
you can take something from it.

Bruce

Sub SetSpreadsheetHeadings( _
forFilePath As String, _
Optional tabName As String)

On Error GoTo Proc_Err
'
' Sets headings for new spreadsheet.
'
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim bolLeaveOpen As Boolean

If IsMissing(tabName) Then tabName = ""

'If Excel is already open, use that instance
bolLeaveOpen = True

'Attempting to use something that is not available
' will generate an error.
On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")

Err.Clear

On Error GoTo Proc_Err

'If xlApp is defined, then we already have a conversation open
If TypeName(xlApp) = "Nothing" Then
bolLeaveOpen = False
'Excel was not open -- create a new instance
Set xlApp = CreateObject("Excel.Application")
End If

'Keep any open workbooks from running any macros while I'm using it.
xlApp.EnableEvents = False

'Open workbook just created.
Set wb = xlApp.Workbooks.Open(forFilePath)

'Keep the workbook from running macros while I use it.
xlApp.EnableEvents = False

'Rename tab.
wb.Worksheets("ExportTemp").Select
If tabName > "" Then
wb.Worksheets("ExportTemp").Name = tabName
Else
tabName = "ExportTemp"
End If

'Select headings row and format.
wb.Worksheets(tabName).Rows("1:1").Select
With xlApp.Selection
.Font.FontStyle = "Bold"
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
With .Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End With

'Set all columns to best width.
wb.Worksheets(tabName).Cells.Select
xlApp.Selection.Columns.AutoFit

'Deselect heading row by selecting single cell.
wb.Worksheets(tabName).Range("A2").Select

'Save changes, then be sure they are saved before continuing.
wb.Save
DoEvents

'Close this specific workbook.
wb.Close False

'Turn macros back on for any workbooks still open.
xlApp.EnableEvents = True

Proc_Exit:
On Error Resume Next

If TypeName(xlApp) <> "Nothing" Then
If Not bolLeaveOpen Then xlApp.Quit
End If

Set wb = Nothing
Set xlApp = Nothing

Err.Clear
Exit Sub

Proc_Err:
MsgBox "Error editing spreadsheet:" & vbCr & vbCr & _
"Error Code: " & Err.Number & vbCr & _
Err.Description, vbOKCritical, "Error!"
Err.Clear

Resume Proc_Exit

End Sub

[Klatuu]

Nice code, Bruce.
I would make one suggestion. The Selection object in Automation can get
squirly on you. It is really better to use the Range object. It seems to be
more stable.

[RoyVidar]

"Klatuu" <Kla...@discussions.microsoft.com> wrote in message
<1042F6C8-8ECD-4446...@microsoft.com>:

Very nice code, Klatuu, I'm sure you have a declaration section
where you declare all the xlConstants, don't you? (probably also
contains declaration of "cell", too?)

Else there'd probably be some challenges going late bound.

--
Roy-Vidar

[Klatuu]

No, it works as is. I have seen other posts stating the xl constants are
only available in late binding, but I have found that not to be true. In
fact, I can go into the immediate window without an instance of Excel running
and query an xl constant and it returns the correct value. Maybe it could be
because I have the Excel 11.0 object library in my references.

I use late binding because when this particular code was written, we had
some users on Office 2000 and some on 2003. Early binding in that case
causes one or the other not to work because the object libraries are
different.

As to the cells, I don't know what you mean. Cells is a property of both
the Worksheet and Range objects.

[BruceS]

Thanks, but I can't take credit. Had help from two different responders, one
from Access Programming and one from Excel General Questions, on how to set
up editing and saving.

Also, thanks for the tip on the Range vs. Selection. Didn't know that.

Bruce

[Klatuu]

I went back and looked more closely at the cell issue. My brain, at first
read cells. Now looking at it, I wonder why it works. It has been in
production since March, 2005. That's weird. I don't even find any refernce
to a cell object or property in help or the object browser.

Well, maybe I discovered something. I promise it works.

[BruceS]

Klatuu,
Wanted everyone to know that it was "strive4peace" ("Crystal") and Roy Vidar
that really helped with my Excel problem last week. Kudos to both!
Bruce

[Klatuu]

They are both good. Excel automation is a very different beast and takes
some special handling to avoid problems, but it is a very powerful tool. I
have had to spend a lot of time with it where I am because the love their
reports done in Excel. Nobody ever uses the printed version.

If you are following this post, Roy found something in my code he
questioned. The part about the Excel constants is understandable, but the
part about the cell I don't know. Since it has been almost 2 years since I
wrote it, I don't remember how I got the idea to use it or why it works.

[RoyVidar]

"Klatuu" <Kla...@discussions.microsoft.com> wrote in message

<5A43E0A8-B6AC-46AF...@microsoft.com>:

> No, it works as is. I have seen other posts stating the xl constants
> are only available in late binding, but I have found that not to be
> true. In fact, I can go into the immediate window without an
> instance of Excel running and query an xl constant and it returns
> the correct value. Maybe it could be because I have the Excel 11.0
> object library in my references.

Yes!

The xlConstants are only available when referencing the automated
application, which is what one would do when using early binding.

Check out Tony Toews article on late binding, with further links
http://www.granite.ab.ca/access/latebinding.htm

> I use late binding because when this particular code was written, we
> had some users on Office 2000 and some on 2003. Early binding in
> that case causes one or the other not to work because the object
> libraries are different.

To me - the reason to go late bound, is to be able to remove the
reference to the automated application. The reference, is the usual
cause for the hassle when moving an app between versions ;-)

> As to the cells, I don't know what you mean. Cells is a property of
> both the Worksheet and Range objects.

I see you've commented it elsethreads - you are using a For Each
Cell... construct a couple of times - is it a possibility that
you've missed Option Explicit in this module? There's a Word object
called Cell, but that would/should probably give some mismatch or
method or member not found error, shouldn't it (and start with
capital C)?

I have a couple of times in the 2003 version, probably with some
beginning corruption, experienced that code has compiled successfully
even with Option Explicit and undeclared variables.

> "RoyVidar" wrote:
>
>> "Klatuu" <Kla...@discussions.microsoft.com> wrote in message
>> <1042F6C8-8ECD-4446...@microsoft.com>:
>>
>> Very nice code, Klatuu, I'm sure you have a declaration section
>> where you declare all the xlConstants, don't you? (probably also
>> contains declaration of "cell", too?)
>>
>> Else there'd probably be some challenges going late bound.
>>
>> --
>> Roy-Vidar
>>
>>
>>

--
Roy-Vidar

[Van T. Dinh]

I think you didn't use Option Explicit and the "cell" wasn't declared as
anything so the Range object is assigned to the variable "cell" in your For
Each statement.

You can check this fairly easily because if I am correct, the For Each ...
loop is only executed once only.

--
HTH
Van T. Dinh
MVP (Access)

"Klatuu" <Kla...@discussions.microsoft.com> wrote in message

news:22C99826-9D00-4E73...@microsoft.com...

[Klatuu]

Not true. I always use Option Explicit.
It is not executed only once. The result is as expected. Each cell in that
range is affected.

Sorry, you are totally incorrect on all points.

I found that I also have the same technique in two other modules.

[Klatuu]

What I read in Tony's article sound different to me than what you are saying.
In addition, what Tony states, I find not to be correct. First, I always
use Option Explicit. I do have a reference to Office 11.0. The following
are the declaration of my objects:

Dim xlApp As Object 'Application Object
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object

The objects are instanciated with this:

Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("excel.application")
Else
DetectExcel
End If

xlApp.DisplayAlerts = False

xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Add

Me.txtStatus = "Building Workbook"
Me.Repaint

'Remove excess worksheets
Do While xlBook.Worksheets.Count > 1
xlApp.Worksheets(xlApp.Worksheets.Count).Delete
Loop
Set xlSheet = xlBook.ActiveSheet

Regardless of how many reasons you can come up with, it compiles, it works
it this and at least two other modules.

The only thing I can think of is that I think I am using late binding, but
in fact, am not. Since I had problems when I first put this together because
of the 10.0 and 11.0 versions, I changed the code based on what I could find
in Knowledgebase articles.

As to cell. I will admit I find no reference to a cell object anywhere, I
am not sure why it is working. This thread has made me curious, so I intendt
to track it down, but believe me, it works as is.

[Stefan Hoffmann]

hi Klatuu,

Klatuu wrote:
> As to cell. I will admit I find no reference to a cell object anywhere, I
> am not sure why it is working. This thread has made me curious, so I intendt
> to track it down, but believe me, it works as is.

It doesn't compile on my machine either. Have you tried your posted code
sample in a new database?

mfG
--> stefan <--

[Klatuu]

Further research:

Here is a copy/paste from VBA Help:

Another easy way to loop through a range is to use a For Each...Next loop
with the collection of cells specified in the Range property. Visual Basic
automatically sets an object variable for the next cell each time the loop
runs. The following procedure loops through the range A1:D10, setting to 0
(zero) any number whose absolute value is less than 0.01.

Sub RoundToZero2()
For Each c In Worksheets("Sheet1").Range("A1:D10").Cells
If Abs(c.Value) < 0.01 Then c.Value = 0
Next
End Sub

And to tie it all up, I spoke before I looked. Option Explicit was not set.
Why, I don't know, because I always (well I thought I did) instist on two
Option statments
Option Explicit
Option Base 0
I know it is the default, but it is self documenting.

So, I added Option Explicit, and dimmed cell as an object. and it works.

I am very glad you and BruceS took the time to review this. At least we
know why it works now and I have corrected my serious sin.

Thanks.

[Douglas J. Steele]

"Klatuu" <Kla...@discussions.microsoft.com> wrote in message

news:DC98C903-E6AE-4C5B...@microsoft.com...

> What I read in Tony's article sound different to me than what you are
> saying.
> In addition, what Tony states, I find not to be correct. First, I always
> use Option Explicit. I do have a reference to Office 11.0.

Then realistically you're using Early Binding, even though you're using the
typical Late Binding function to instantiate the objects.

There's nothing in that code that I can see that shouldn't compile, whether
using Late Binding or Early Binding.

If your code was using any of the intrinsic Excel constants (xlBottom,
xlLeft, etc., etc.), then your code would not compile if you were using Late
Binding, unless you explicitly declare each of the Excel constants you're
using.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)

[Andreas]

Hello,

first of all thanks to everybody who contributed to this discussion.
I've take your ideas/ codes and entered them into my vba environment.
The problem, vba tells me it doesn't recognize

Dim xlApp As Excel.Application
Dim Wb As Excel.Workbook

saying "user-defined type not defined." What do I need to do to correct
this error as I have seen it before.

Thanks,

Andreas

[Douglas J. Steele]

You're attempting to use Early Binding, which means that you need to go into
Tools | References while you're in the VB Editor, scroll through the list of
available references until you find the one for Microsoft Excel n.0 Object
Library (n will be 11 for Excel 2003, 10 for Excel 2002, 9 for Excel 2000, 8
for Excel 97 and so on) and select it.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)

"Andreas" <andreas....@ny.frb.org> wrote in message
news:1163434001.7...@h48g2000cwc.googlegroups.com...

[Van T. Dinh]

Yes, I myself wasn't entirely convinced in my last post as indicated ...

The reason is that the For Each statement works with a collection and
therefore, somehow the Range has to be interprested as a collection. I
found that even though the Default Property of the Range object is Item but
it can be intepreted as Cells on how Item is used.

I see that you also found the Help details about the For Each ... with the
Range object.

--

Van T. Dinh
MVP (Access)

"Klatuu" <Kla...@discussions.microsoft.com> wrote in message

news:A3D1ED18-BF91-4C4D...@microsoft.com...

[geod...@gmail.com]

good stuff thanks.