Excel formating not always working

[PeDa]

My Access application reads data from database tables and writes them to Excel, repeatedly making a new workbook and then making new worksheets therein, which are then filled with data and then formatted, stuff like:

locNewRange = "A3:K" & Trim(Str(locRow_n))
objSht.Range(locNewRange).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
End With

Finally the workbook is saved, and the whole process is repeated for the next workbook. For some reason this works fine for the first workbook, but not for subseqent ones: evenything is written to Excel, but the formatting is not carried out; there are no error messages. The only way I have found that works, is to completely close Access, and then restart it to make the next workbook (just closing and reopening the application isn't enough). Any suggestions?

 

[SkipVought]

Hi,

need to see ALL your MS Access VBA code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

You have to use full qualified excel objects.
For instance, replace this:
Selection.
with something like this:
yourExcelApplicationObject.Selection.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PeDa]

Here is a slimmed down version of my application that demonstrates the problem (in a slightly different form)

Option Compare Database
Option Explicit

Dim objXL As Object
Dim objWkb As Object
Dim objSht As Object

'======================================================================
Private Sub butStartHere_Click()
Call Department1
Call Department2
End Sub
'======================================================================

Private Sub Department1()
Call OpenWorkbook
Call NewTeam("Demo1", "A", "Team A")
Call NewTeam("Demo1", "B", "Team B")
Call SaveWorkbook("1")
End Sub
'======================================================================

Private Sub Department2()
Call OpenWorkbook
Call NewTeam("Demo2", "C", "Team C")
Call NewTeam("Demo2", "D", "Team D")
Call SaveWorkbook("2")
End Sub
'======================================================================

Private Sub OpenWorkbook()
Set objXL = CreateObject("Excel.Application")
objXL.Application.Workbooks.Add
Set objWkb = objXL.Application.ActiveWorkbook
objXL.Visible = True
End Sub
'======================================================================

Private Sub SaveWorkbook(MyDepartment)
objWkb.Worksheets("Sheet1").Delete
objWkb.Worksheets("Sheet2").Delete
objWkb.Worksheets("Sheet3").Delete
objWkb.SaveAs MyDepartment & "_Demo.xls"
objWkb.Close
Set objSht = Nothing
Set objWkb = Nothing
objXL.Quit
Set objXL = Nothing
End Sub
'======================================================================

Private Sub NewTeam(MijnBU, MyDepartment, MijnTeam)
Dim MyRange As String
Dim MyRow As Integer
objWkb.Worksheets.Add().Name = MijnTeam
Set objSht = objWkb.Worksheets(MijnTeam)
objSht.Activate

MyRow = 1
objSht.Cells(MyRow, 1) = "Bla bla bla bla bla bla bla"
objSht.Cells(MyRow, 1).Font.Bold = True

MyRow = 3
objSht.Cells(MyRow, 1) = "bla bla bla"
objSht.Cells(MyRow, 2) = "bla bla bla"
objSht.Cells(MyRow, 3) = "bla bla bla"
objSht.Cells(MyRow, 4) = "bla bla bla"
objSht.Cells(MyRow, 5) = "bla bla bla"
objSht.Cells(MyRow, 6) = "bla bla bla"
objSht.Cells(MyRow, 7) = "bla bla bla"
objSht.Cells(MyRow, 8) = "bla bla bla"
objSht.Cells(MyRow, 9) = "bla bla bla"
objSht.Cells(MyRow, 10) = "bla bla bla"
objSht.Cells(MyRow, 11) = "bla bla bla"
MyRow = 4
objSht.Cells(MyRow, 1) = "bla bla bla"
objSht.Cells(MyRow, 2) = "bla bla bla"
objSht.Cells(MyRow, 3) = "bla bla bla"
objSht.Cells(MyRow, 4) = "bla bla bla"
objSht.Cells(MyRow, 5) = "bla bla bla"
objSht.Cells(MyRow, 6) = "bla bla bla"
objSht.Cells(MyRow, 7) = "bla bla bla"
objSht.Cells(MyRow, 8) = "bla bla bla"
objSht.Cells(MyRow, 9) = "bla bla bla"
objSht.Cells(MyRow, 10) = "bla bla bla"
objSht.Cells(MyRow, 11) = "bla bla bla"

'format this table

MyRange = "A3:K" & Trim(Str(MyRow))
objSht.Range(MyRange).Select
[COLOR=red][b]With Selection.Borders(xlEdgeLeft)[/b][/color]
  .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
With Selection.Borders(xlInsideHorizontal)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
End With
objSht.Columns("A:A").Select
Selection.Columns.AutoFit
objSht.Columns("B:K").Select
Selection.ColumnWidth = 10
objSht.Range("B3:K3").Select
With Selection
  .HorizontalAlignment = xlCenter
  .VerticalAlignment = xlTop
  .WrapText = True
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False
End With
MyRange = "B4:K" & Trim(Str(MyRow))
objSht.Range(MyRange).Select
With Selection
  .HorizontalAlignment = xlRight
  .VerticalAlignment = xlBottom
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 2
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False
End With

End Sub
'======================================================================

The subroutine "Department1" runs successfully and makes and saves a properly formatted spreadsheet. Subroutine "Department2" now fails with an "Object variable or with block variable not set" message at the line in subroutine "NewTeam" shown in red above (I assume this is another manifestation of my original problem, I have now removed an "On Error Resume Next" statement, added to the original in despiration).

 

[PHV]

Again, replace all Selection with [!]objXL.[/!]Selection

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[SkipVought]

[s]objSht.Range(MyRange).Select[/s]
With objSht.Range(MyRange)
    With .Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
    With .Borders(xlInsideVertical)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
    With .Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
End With

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PeDa]

Hello PHV and Skip,

Thank you for these (and sorry for not initially understanding PHV's response). This has indeed solved the problem, that has been gnawing at me for months. I can now finally run the programme as intended (on its own in the lunch hour), instead of spending half the morning doing it bit by bit.

- Peter