Late binding to Excel from Access causing Object error

  • Thread starter EagleOne@microsoftdiscussiongroups
  • Start date
E

EagleOne@microsoftdiscussiongroups

2003

Assume Access just completed VBA transfering 21 Tables to 21 XL spreadsheets
on One workbook.

Then, via Automation, I wish to format all 21 sheets in the XLS w/b file.

The Automation For Next loop does not cycle through all W/S's in the XL w/b
file. It just formats the first w/s 21 times.

I then thought that maybe I needed to save the XL w/b with 21 sheets first,
then attempt to format all of them.

At EOD, I want to have all 21 sheets in one w/b looped through the
FormatXLSheets Sub.

My Automation code (99% Dev Ashish's Automation Code) follows:

Would someone review my code to ascertain why it does not sequence through
to 21 XL w/s?

Dave Hargis, Microsoft Access MVP AKA Klatuu, feels that the late binding
and after Dimming: Dim wks As Object, is causing VBA

Then the following loop does not work (does not cycle through all sheets -
loops through sheet1 21 times) because VBA is not sure what to do with
"wks" as Dimmed As Object vs Dimmed as Worksheet.

For Each wks in Worksheets

Next wks

Any work-arounds; additional thoughts?

TIA EagleOne
****************************************************

Sub FormatXLSheets(myPathFile As String, myFileName As String)
'
'Code Courtesy of Dev Ashish
'
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objActiveWkb As Object

' Variables related to Excel Formatting
Dim wks As Object
Dim myRange As Object
Dim myRange2 As Object
Dim myCell As Object
Dim myRowsToProcess As Long
Dim myColumnsToProcess As Long
Dim MaxRows As Long
Dim MaxColumns As Long

If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

With objXL.Application
..Visible = False
..workbooks.Open myPathFile
End With
Set objActiveWkb = objXL.Application.ActiveWorkBook

With objActiveWkb
'
Set wks = Nothing
For Each wks In .worksheets
With wks
MaxRows = .Rows.Count
MaxColumns = .Columns.Count
End With
'
'
'
' (Series of formatting steps in Excel
'
'

Cells.EntireColumn.AutoFit
Range("A1").Select
Next wks
End With

objActiveWkb.Close savechanges:=True

'If boolXL Then objXL.Application.Quit

objXL.Application.Quit

Set objActiveWkb = Nothing: Set objXL = Nothing

End Sub
 
J

Jim Rech

Since you want to select A1 on each sheet you have to activate each one.
Then your other code will work too.

With objActiveWkb
For Each wks In .worksheets
wks.Activate
MaxRows = wks.Rows.Count
MaxColumns = wks.Columns.Count
' (Series of formatting steps in Excel
Cells.EntireColumn.AutoFit
Range("A1").Select
Next wks
End With

--
Jim
"EagleOne@microsoftdiscussiongroups"
message | 2003
|
| Assume Access just completed VBA transfering 21 Tables to 21 XL
spreadsheets
| on One workbook.
|
| Then, via Automation, I wish to format all 21 sheets in the XLS w/b file.
|
| The Automation For Next loop does not cycle through all W/S's in the XL
w/b
| file. It just formats the first w/s 21 times.
|
| I then thought that maybe I needed to save the XL w/b with 21 sheets
first,
| then attempt to format all of them.
|
| At EOD, I want to have all 21 sheets in one w/b looped through the
| FormatXLSheets Sub.
|
| My Automation code (99% Dev Ashish's Automation Code) follows:
|
| Would someone review my code to ascertain why it does not sequence through
| to 21 XL w/s?
|
| Dave Hargis, Microsoft Access MVP AKA Klatuu, feels that the late binding
| and after Dimming: Dim wks As Object, is causing VBA
|
| Then the following loop does not work (does not cycle through all sheets -
| loops through sheet1 21 times) because VBA is not sure what to do with
| "wks" as Dimmed As Object vs Dimmed as Worksheet.
|
| For Each wks in Worksheets
|
| Next wks
|
| Any work-arounds; additional thoughts?
|
| TIA EagleOne
| ****************************************************
|
| Sub FormatXLSheets(myPathFile As String, myFileName As String)
| '
| 'Code Courtesy of Dev Ashish
| '
| Dim objXL As Object
| Dim strWhat As String, boolXL As Boolean
| Dim objActiveWkb As Object
|
| ' Variables related to Excel Formatting
| Dim wks As Object
| Dim myRange As Object
| Dim myRange2 As Object
| Dim myCell As Object
| Dim myRowsToProcess As Long
| Dim myColumnsToProcess As Long
| Dim MaxRows As Long
| Dim MaxColumns As Long
|
| If fIsAppRunning("Excel") Then
| Set objXL = GetObject(, "Excel.Application")
| boolXL = False
| Else
| Set objXL = CreateObject("Excel.Application")
| boolXL = True
| End If
|
| With objXL.Application
| .Visible = False
| .workbooks.Open myPathFile
| End With
| Set objActiveWkb = objXL.Application.ActiveWorkBook
|
| With objActiveWkb
| '
| Set wks = Nothing
| For Each wks In .worksheets
| With wks
| MaxRows = .Rows.Count
| MaxColumns = .Columns.Count
| End With
| '
| '
| '
| ' (Series of formatting steps in Excel
| '
| '
|
| Cells.EntireColumn.AutoFit
| Range("A1").Select
| Next wks
| End With
|
| objActiveWkb.Close savechanges:=True
|
| 'If boolXL Then objXL.Application.Quit
|
| objXL.Application.Quit
|
| Set objActiveWkb = Nothing: Set objXL = Nothing
|
| End Sub
|
 
E

EagleOne@microsoftdiscussiongroups

Jim,

I figured that the answer would be fixing a simple step.

That said, what else can I do besides wks.activate?

If you notice, in the Late-binding code I:
used "With objXL.Application.Visible = False"

Adding wks.activate to the loop caused all instances of Excel, in turn,
initiated by 21 DoCmd.TransferSpreadSheet's to stay active. Also,
none of the sheets were formatted.

It seems that I traded my original challenge of having multiple-sheet
workbooks have all sheets formated (in lieu of just the 1st sheet) and all
instances of Excel closed to the inverse of both respectively.

Now, I further believe that I am missing a different simple step to make all
work.

Thoughts?

TIA EagleOne
 
J

Jim Rech

If you don't activate each sheet then selecting A1 will not work (except on
the active sheet), so you might as well get rid of that line.

Prefix every range/cell reference with wks, or use With:

With wks
.Range("A1").Font.Bold= True
'etc
End With
or

wks.Range("A1").Font.Bold= True

You have a "With wks" but it looks like your formatting comes after it.
Move it inside it and of course use "." .


--
Jim
"EagleOne@microsoftdiscussiongroups"
message | Jim,
|
| I figured that the answer would be fixing a simple step.
|
| That said, what else can I do besides wks.activate?
|
| If you notice, in the Late-binding code I:
| used "With objXL.Application.Visible = False"
|
| Adding wks.activate to the loop caused all instances of Excel, in turn,
| initiated by 21 DoCmd.TransferSpreadSheet's to stay active. Also,
| none of the sheets were formatted.
|
| It seems that I traded my original challenge of having multiple-sheet
| workbooks have all sheets formated (in lieu of just the 1st sheet) and all
| instances of Excel closed to the inverse of both respectively.
|
| Now, I further believe that I am missing a different simple step to make
all
| work.
|
| Thoughts?
|
| TIA EagleOne
|
| "Jim Rech" wrote:
|
| > Since you want to select A1 on each sheet you have to activate each one.
| > Then your other code will work too.
| >
| > With objActiveWkb
| > For Each wks In .worksheets
| > wks.Activate
| > MaxRows = wks.Rows.Count
| > MaxColumns = wks.Columns.Count
| > ' (Series of formatting steps in Excel
| > Cells.EntireColumn.AutoFit
| > Range("A1").Select
| > Next wks
| > End With
| >
| > --
| > Jim
| > "EagleOne@microsoftdiscussiongroups"
| > message | > | 2003
| > |
| > | Assume Access just completed VBA transfering 21 Tables to 21 XL
| > spreadsheets
| > | on One workbook.
| > |
| > | Then, via Automation, I wish to format all 21 sheets in the XLS w/b
file.
| > |
| > | The Automation For Next loop does not cycle through all W/S's in the
XL
| > w/b
| > | file. It just formats the first w/s 21 times.
| > |
| > | I then thought that maybe I needed to save the XL w/b with 21 sheets
| > first,
| > | then attempt to format all of them.
| > |
| > | At EOD, I want to have all 21 sheets in one w/b looped through the
| > | FormatXLSheets Sub.
| > |
| > | My Automation code (99% Dev Ashish's Automation Code) follows:
| > |
| > | Would someone review my code to ascertain why it does not sequence
through
| > | to 21 XL w/s?
| > |
| > | Dave Hargis, Microsoft Access MVP AKA Klatuu, feels that the late
binding
| > | and after Dimming: Dim wks As Object, is causing VBA
| > |
| > | Then the following loop does not work (does not cycle through all
sheets -
| > | loops through sheet1 21 times) because VBA is not sure what to do
with
| > | "wks" as Dimmed As Object vs Dimmed as Worksheet.
| > |
| > | For Each wks in Worksheets
| > |
| > | Next wks
| > |
| > | Any work-arounds; additional thoughts?
| > |
| > | TIA EagleOne
| > | ****************************************************
| > |
| > | Sub FormatXLSheets(myPathFile As String, myFileName As String)
| > | '
| > | 'Code Courtesy of Dev Ashish
| > | '
| > | Dim objXL As Object
| > | Dim strWhat As String, boolXL As Boolean
| > | Dim objActiveWkb As Object
| > |
| > | ' Variables related to Excel Formatting
| > | Dim wks As Object
| > | Dim myRange As Object
| > | Dim myRange2 As Object
| > | Dim myCell As Object
| > | Dim myRowsToProcess As Long
| > | Dim myColumnsToProcess As Long
| > | Dim MaxRows As Long
| > | Dim MaxColumns As Long
| > |
| > | If fIsAppRunning("Excel") Then
| > | Set objXL = GetObject(, "Excel.Application")
| > | boolXL = False
| > | Else
| > | Set objXL = CreateObject("Excel.Application")
| > | boolXL = True
| > | End If
| > |
| > | With objXL.Application
| > | .Visible = False
| > | .workbooks.Open myPathFile
| > | End With
| > | Set objActiveWkb = objXL.Application.ActiveWorkBook
| > |
| > | With objActiveWkb
| > | '
| > | Set wks = Nothing
| > | For Each wks In .worksheets
| > | With wks
| > | MaxRows = .Rows.Count
| > | MaxColumns = .Columns.Count
| > | End With
| > | '
| > | '
| > | '
| > | ' (Series of formatting steps in Excel
| > | '
| > | '
| > |
| > | Cells.EntireColumn.AutoFit
| > | Range("A1").Select
| > | Next wks
| > | End With
| > |
| > | objActiveWkb.Close savechanges:=True
| > |
| > | 'If boolXL Then objXL.Application.Quit
| > |
| > | objXL.Application.Quit
| > |
| > | Set objActiveWkb = Nothing: Set objXL = Nothing
| > |
| > | End Sub
| > |
| >
| >
| >
 
E

EagleOne

For those interested in Automating Access to move data from Access then
format those worksheets, EagleOne offers working procedures. Modify for your
use as needed.

Notice especially that "Excel" objects like Worksheets and Ranges are Dimmed
as "Objects" because of "Late Binding."

EagleOne owes most of this work/knowledge to Dev Ashish; Jim Rech; Dave Hargis
and others whom I believe are all MS MVP's.

All of the VBA code below goes into an Access VBA Module. The Excel procedures
are accomplished from Access.

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

Private Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, _
ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
"SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal _
wParam As Long, lParam As Long) As Long

Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
"SetForegroundWindow" (ByVal Hwnd As Long) As Long

Private Declare Function apiShowWindow Lib "user32" Alias _
"ShowWindow" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function apiIsIconic Lib "user32" Alias _
"IsIconic" (ByVal Hwnd As Long) As Long

Private Declare Sub sapiSleep Lib "kernel32" _
Alias "Sleep" (ByVal dwMilliseconds As Long)


'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10

Function fIsAppRunning(ByVal strAppName As String, _
Optional fActivate As Boolean) As Boolean
Dim lngH As Long, strClassName As String
Dim lngX As Long, lngTmp As Long
Const WM_USER = 1024
On Local Error GoTo fIsAppRunning_Err
fIsAppRunning = False
Select Case LCase$(strAppName)
Case "excel": strClassName = "XLMain"
Case "word": strClassName = "OpusApp"
Case "access": strClassName = "OMain"
Case "powerpoint95": strClassName = "PP7FrameClass"
Case "powerpoint97": strClassName = "PP97FrameClass"
Case "notepad": strClassName = "NOTEPAD"
Case "paintbrush": strClassName = "pbParent"
Case "wordpad": strClassName = "WordPadClass"
Case Else: strClassName = vbNullString
End Select

If strClassName = "" Then
lngH = apiFindWindow(vbNullString, strAppName)
Else
lngH = apiFindWindow(strClassName, vbNullString)
End If
If lngH <> 0 Then
apiSendMessage lngH, WM_USER + 18, 0, 0
lngX = apiIsIconic(lngH)
If lngX <> 0 Then
lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
End If
If fActivate Then
lngTmp = apiSetForegroundWindow(lngH)
End If
fIsAppRunning = True
End If
fIsAppRunning_Exit:
Exit Function
fIsAppRunning_Err:
fIsAppRunning = False
Resume fIsAppRunning_Exit
End Function
'******************** Code End ****************

Sub Export_Files_Macro()
'
'
' NOTE: If you wish to transfer tables as separate sheets in the
' same Excel workbook, just keep the receiving filename the same!!
' (See example below)
'
Dim myPath As String
Dim myDate As String
Dim myTime As String
Dim myFileName As String
Dim myPathFile As String

MsgBox ("This procedure may take up to XXX minutes" & Chr(10) _
& Chr(10) & " Press OK to continue .... ")
myPath = CurrentProject.Path & "\"
myDate = Replace(Date, "/", "-")
myTime = Format(Time(), "hhmm")
myFileName = "CHR_ALL_AAASITE_TBL " & myDate & " " & myTime & ".xls"
myPathFile = myPath & myFileName
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"CHR_ALL_AAASITE_TBL", myPath & myFileName, True
If Not Err.Number > 0 Then
Call FormatXLSheets(myPathFile, myFileName)
End If
On Error GoTo 0
myFileName = "FNR_ALL_AAASITE_TBL " & myDate & " " & myTime & ".xls"
myPathFile = myPath & myFileName
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"FNR_ALL_AAASITE_TBL", myPath & myFileName, True
If Not Err.Number > 0 Then
Call FormatXLSheets(myPathFile, myFileName)
End If
On Error GoTo 0
myFileName = "FSD_ALL_AAASITE_TBL " & myDate & " " & myTime & ".xls"
myPathFile = myPath & myFileName
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"FSD_ALL_AAASITE_TBL", myPath & myFileName, True
If Not Err.Number > 0 Then
Call FormatXLSheets(myPathFile, myFileName)
End If

'**********************************************************************
'
' NOTE: If you wish to transfer tables as separate sheets in the same
' Excel workbook, just keep the receiving filename the same!!
' (See example next below)
'
myFileName = "FBWT_ALL_Tables " & myDate & " " & myTime & ".xls"
myPathFile = myPath & myFileName
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"CHR_ALL_AAASITE_TBL", myPath & myFileName, True
On Error GoTo 0
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"FNR_ALL_AAASITE_TBL", myPath & myFileName, True
On Error GoTo 0
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"FSD_ALL_AAASITE_TBL", myPath & myFileName, True
On Error GoTo 0
Call FormatXLSheets(myPathFile, myFileName)
MsgBox "Procedure Completed!"

If Err.Number > 0 Then
MsgBox Error$
Stop
End If

End Sub

' Note: The two variables passed from Export_Files_Macro() above
Sub FormatXLSheets(myPathFile As String, myFileName As String)
'
'Essence of VBA Code Courtesy of Dev Ashish
' modified only for detail w/s procedures by
' EagleOne 6/13/2008
'
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objActiveWkb As Object
Dim Wks As Object
Dim myRange As Object
Dim myRange2 As Object
Dim myRowsToProcess As Long
Dim myColumnsToProcess As Long
Dim MaxRows As Long
Dim MaxColumns As Long

If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

With objXL.Application
'.Visible = True
.Visible = False
'Open the Workbook
.workbooks.Open myPathFile
'.ActiveWorkBook.RunAutoMacros xlAutoOpen
End With
Set objActiveWkb = objXL.Application.ActiveWorkBook
With objActiveWkb
Set Wks = Nothing
For Each Wks In .Worksheets
Wks.Activate
'Determine which Excel version re: Worksheet capacity
With Wks
MaxRows = .Rows.Count
MaxColumns = .Columns.Count
End With

'Accurately determine the usedrange for Autofilter
myRowsToProcess = Cells.Find(What:="*", After:=Wks.Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
myColumnsToProcess = Cells.Find(What:="*", After:=Wks.Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
myRowsToProcess = IIf(myRowsToProcess > MaxRows, MaxRows, _
myRowsToProcess) myColumnsToProcess = _
IIf(myColumnsToProcess > MaxColumns, MaxColumns, myColumnsToProcess)
Set myRange = Wks.Range(Cells(1, 1), _
Cells(myRowsToProcess, myColumnsToProcess))
Set myRange = Intersect(myRange, myRange.SpecialCells(xlCellTypeVisible))

myRange.AutoFilter

With Wks
'Format dollar columns
Columns("O:S").NumberFormat = _
"_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
'Select bold & "box" headers
Wks.Range(Cells(1, 1), Cells(1, myColumnsToProcess)).Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
'Filter and "color" questionable data items
myRange.AutoFilter Field:=5, Criteria1:="Not Found"
On Error Resume Next
Set myRange2 = Intersect(Wks.Range(Cells(2, 5), _
Cells(myRowsToProcess, 5)), _
myRange.SpecialCells(xlCellTypeVisible))
If Not Err.Number > 0 Then
myRange2.Interior.ColorIndex = 6
myRange.AutoFilter Field:=5
End If
myRange.AutoFilter Field:=11, Criteria1:="Not Found"
On Error Resume Next
Set myRange2 = Intersect(Wks.Range(Cells(2, 11), _
Cells(myRowsToProcess, 11)), _
myRange.SpecialCells(xlCellTypeVisible))
If Not Err.Number > 0 Then
myRange2.Interior.ColorIndex = 6
myRange.AutoFilter Field:=11
End If
myRange.AutoFilter Field:=14, Criteria1:="Inv"
On Error Resume Next
Set myRange2 = Intersect(Wks.Range(Cells(2, 14), _
Cells(myRowsToProcess, 14)), _
myRange.SpecialCells(xlCellTypeVisible))
If Not Err.Number > 0 Then
myRange2.Interior.ColorIndex = 6
myRange.AutoFilter Field:=14
End If
'Sort & Filter
myRange.AutoFilter
If InStr(1, myFileName, "XXXXXXX", vbTextCompare) > 0 Then
myRange.Sort Key1:=Range("M2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key3:=Range("J2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortTextAsNumbers
Else
myRange.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("M2"), Order2:=xlAscending, _
Key3:=Range("J2"), Order3:=xlAscending, Header:= xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortTextAsNumbers
End If
myRange.AutoFilter
' Add TOtals & Underlines
Cells(Rows.Count, "O").End(xlUp)(3, 1).Formula = _
"=SUM(O2:O" & Cells(Rows.Count, 1).End(xlUp)(1, 1).Row & ")"
Cells(Rows.Count, "P").End(xlUp)(3, 1).Formula = _
"=SUM(P2:p" & Cells(Rows.Count, 1).End(xlUp)(1, 1).Row & ")"
Cells(Rows.Count, "Q").End(xlUp)(3, 1).Formula = _
"=SUM(Q2:Q" & Cells(Rows.Count, 1).End(xlUp)(1, 1).Row & ")"
Cells(Rows.Count, "R").End(xlUp)(3, 1).Formula = _
"=SUM(R2:R" & Cells(Rows.Count, 1).End(xlUp)(1, 1).Row & ")"
Cells(Rows.Count, "S").End(xlUp)(3, 1).Formula = _
"=SUM(S2:S" & Cells(Rows.Count, 1).End(xlUp)(1, 1).Row & ")"
Range(Cells(Rows.Count, "O").End(xlUp)(1, 1).Address & _
":" & Cells(Rows.Count, "S").End(xlUp)(1, 1).Address).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Cells.EntireColumn.AutoFit
Range("A1").Select
Next Wks
End With
On Error Resume Next
Worksheets(1).Activate
On Error Resume Next
objActiveWkb.Close savechanges:=True
On Error Resume Next
objXL.Application.Quit
Set objActiveWkb = Nothing: Set objXL = Nothing

End Sub

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top