Access VBA to format Excel workbook

TheNoocH

Well-known Member
Joined
Oct 6, 2004
Messages
3,482
I used transferspreadsheet to transfer a query to an Excel Spreadsheet...i wrote the following code to format the spreadsheet...the code seems to work and format everything as expected...BUT...i was expecting the Excel spreadsheet to be visible at the end of the code...but it isn't...also if i try to manually open the newly formatted spreadsheet (via Windows Explorer) it won't open either...but if i open any other spreadsheet then the formatted spreadsheet is in the other window...here's my code...any thoughts on what i am doing wrong?
Thanks

Code:
Sub OpenAndFormatExcel()
  On Error Resume Next
  Dim filePath As String
  filePath = CurrentProject.Path & "\UnitSalesByCust" & Forms!frmMain.cboCust & ".xls"
  Dim xl As Excel.Application
  Dim xlBook As Excel.workbook
  Dim xlSheet As Excel.worksheet
  Set xl = CreateObject("Excel.Application")
  Set xlBook = GetObject(filePath)
  xl.Visible = True
  xlBook.Windows(1).Visible = True
  Set xlSheet = xlBook.Worksheets(1)
    
  Range("A1:P1").Font.Bold = True
  For Each cell In Range(Cells(1, "F"), Cells(Cells(Rows.Count, "F").End(xlUp).Row, "F"))
      If Right(cell.Value, 5) = "TOTAL" Then Range(Cells(cell.Row, "A"), Cells(cell.Row, "P")).Font.Bold = True
  Next cell
  Rows("1:3").Insert
  Range("C1") = Range("B5") & " (" & Range("A5") & ")"
  Range("C2") = Format(Range("O5"), "mm/dd/yy") & " - " & Format(Range("P5"), "mm/dd/yy")
  With Range("C1:N1")
      .HorizontalAlignment = xlCenter
      .Merge
      .Font.Size = 24
      .Font.Bold = True
  End With
  With Range("C2:N2")
      .HorizontalAlignment = xlCenter
      .Merge
      .Font.Size = 12
      .Font.Bold = True
  End With
    
  If Forms!frmMain.chkIncludeGM = -1 Then
      Range("J:J,N:N").NumberFormat = "0.00%"
      Range("A:B,O:P").Delete Shift:=xlToLeft
  Else
      Range("A:B,O:P,J:J,N:N").Delete Shift:=xlToLeft
  End If
  Cells.Columns.AutoFit
  xl.Application.Goto Range("A3")
 
  xlBook.Save
  
  Set xl = Nothing
  Set xlBook = Nothing
  Set xlSheet = Nothing
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
There's definitely one thing you are doing wrong - not using a worksheet reference for all the Ranges.

Also I suggest you remove On Error Resume Next, that could be hiding any errors.

As to why Excel isn't visible, I can't see anywhere you make it visible in the code.:)
 
Upvote 0
There's definitely one thing you are doing wrong - not using a worksheet reference for all the Ranges.

Also I suggest you remove On Error Resume Next, that could be hiding any errors.

As to why Excel isn't visible, I can't see anywhere you make it visible in the code.:)

Norie,
I realized that and have been working on adding them...should i be using xlSheet or xl? Also do you see anywhere i'm missing them now?
what i realized was that if you close Excel from within Excel...it leaves an instance of EXCEL.EXE in the processes...
OK...removed the On Error line
don't these 2 lines make Excel and the first Worksheet visible?

Code:
  xl.Visible = True
  xlBook.Windows(1).Visible = True


Code:
Sub OpenAndFormatExcel()
  Dim filePath As String
  filePath = CurrentProject.Path & "\UnitSalesByCust" & Forms!frmMain.cboCust & ".xls"
  Dim xl As Excel.Application
  Dim xlBook As Excel.workbook
  Dim xlSheet As Excel.worksheet
  Set xl = CreateObject("Excel.Application")
  Set xlBook = GetObject(filePath)
  xl.Visible = True
  xlBook.Windows(1).Visible = True
  Set xlSheet = xlBook.Worksheets(1)
    
  xlSheet.Range("A1:P1").Font.Bold = True
  For Each cell In xlSheet.Range(xlSheet.Cells(1, "F"), xlSheet.Cells(xlSheet.Cells(xlSheet.Rows.Count, "F").End(xlUp).Row, "F"))
      If Right(cell.Value, 5) = "TOTAL" Then xlSheet.Range(xlSheet.Cells(cell.Row, "A"), xlSheet.Cells(cell.Row, "P")).Font.Bold = True
  Next cell
  xlSheet.Rows("1:3").Insert
  xlSheet.Range("C1") = xlSheet.Range("B5") & " (" & xlSheet.Range("A5") & ")"
  xlSheet.Range("C2") = Format(xlSheet.Range("O5"), "mm/dd/yy") & " - " & Format(xlSheet.Range("P5"), "mm/dd/yy")
  With xlSheet.Range("C1:N1")
      .HorizontalAlignment = xlCenter
      .Merge
      .Font.Size = 24
      .Font.Bold = True
  End With
  With xlSheet.Range("C2:N2")
      .HorizontalAlignment = xlCenter
      .Merge
      .Font.Size = 12
      .Font.Bold = True
  End With
    
  If Forms!frmMain.chkIncludeGM = -1 Then
      xlSheet.Range("J:J,N:N").NumberFormat = "0.00%"
      xlSheet.Range("A:B,O:P").Delete Shift:=xlToLeft
  Else
      xlSheet.Range("A:B,O:P,J:J,N:N").Delete Shift:=xlToLeft
  End If
  xlSheet.Cells.Columns.AutoFit
  xl.Application.Goto Range("A3")
 
  xlBook.Save
  xl.Quit
  Set xl = Nothing
  Set xlBook = Nothing
  Set xlSheet = Nothing
End Sub
 
Upvote 0
try this

Code:
'***********************************************************
' from the Visual Basic menu select
' Tools / References / Microsoft 11.0 Object Library
' or whatever version of excel you have
'***********************************************************
Private Sub OpenAndFormatExcel()
    
    Dim filePath As String
    '****
    ' change this
    '****
    filePath = "c:\james\testing.xls"
    
    Dim xl As Excel.Application
    Dim xlBook As Excel.workbook
    Dim xlSheet As Excel.worksheet
    
    Set xl = New Excel.Application
    
    Set xlBook = xl.Workbooks.Open(filePath)
    
    Set xlSheet = xlBook.Worksheets(1)
    
    xl.Visible = True
    
    With xlSheet
        .Range("A1:P1").Font.Bold = True
        For Each cell In .Range(.Cells(1, "F"), .Cells(.Cells(.Rows.Count, "F").End(xlUp).Row, "F"))
            If Right(cell.Value, 5) = "TOTAL" Then
                .Range(.Cells(cell.Row, "A"), .Cells(cell.Row, "P")).Font.Bold = True
            End If
        Next cell
        
        .Rows("1:3").Insert
        .Range("C1") = .Range("B5") & " (" & .Range("A5") & ")"
        .Range("C2") = Format(.Range("O5"), "mm/dd/yy") & " - " & Format(.Range("P5"), "mm/dd/yy")
        With .Range("C1:N1")
            .HorizontalAlignment = Excel.xlCenter
            .Merge
            .Font.Size = 24
            .Font.Bold = True
        End With
        With .Range("C2:N2")
            .HorizontalAlignment = Excel.xlCenter
            .Merge
            .Font.Size = 12
            .Font.Bold = True
        End With

        '****
        ' change this
        '****
        'If Forms!frmMain.chkIncludeGM = -1 Then
        If -1 = -1 Then
            .Range("J:J,N:N").NumberFormat = "0.00%"
            .Range("A:B,O:P").Delete Shift:=Excel.xlToLeft
        Else
            .Range("A:B,O:P,J:J,N:N").Delete Shift:=Excel.xlToLeft
        End If
        
        .Cells.Columns.AutoFit
        
        xl.Goto .Range("A3")
    End With
    
    xl.DisplayAlerts = False
    
    xlBook.Save
    '*** uncomment to keep open
    'xlBook.Close True
    
    xl.DisplayAlerts = True
    
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xl = Nothing
    
End Sub
'***********************************************************
 
Upvote 0
James,
That seems to have done the trick...couple of follow-up questions:

1) what is the diff b/t
set xl= new excel.application
and
set xl=createobject("Excel.Application")

2) what is the diff b/t
set xlBook = xl.workbooks.open(filePath)
and
set xlbook = getobject(filepath)

3) assuming it's related to #1 or 2 above...but how come we don't need xlbook.windows(1).visible=true?

4) at the end there is xl.displayalerts=true ... why would we need this without setting it to false somewhere earlier?

5) unrelated but maybe you have an idea...i have a transferspreadsheet before this code that isn't overwriting the file if there was one...i have created numerous transferspreadsheets where it would overwrite...would it have anything to do with it being automated? i did a workaround and delete the file before i transferspreadsheet...

thanks again...
 
Upvote 0
in my code before the xlBook.Save line i'd like to include this call to another SUB...but it's not working properly...any thoughts on how to get this working? I wrote this code in Excel and it works...i tried a bit to make it so it was accessible from Access...i didn't know if i had to do all the set statements at the top of my other code...mainly because the file is already opened...so i figured it must be some other code...any help would be great...

Code:
  Call SetUpPage(xlSheet, "", "L", "$1:$4")

Code:
Sub SetUpPage(ws As Worksheet, Heading As String, Orient As String, RepeatRows As String)
   On Error GoTo ErrHand
   Dim xl As Excel.Application
   xl.ScreenUpdating = False
   With ws
     With .PageSetup
        .LeftHeader = ""
        .CenterHeader = Heading
        .RightHeader = "Page &P of &N"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = xl.InchesToPoints(0.75)
        .RightMargin = xl.InchesToPoints(0.75)
        .TopMargin = xl.InchesToPoints(1)
        .BottomMargin = xl.InchesToPoints(1)
        .HeaderMargin = xl.InchesToPoints(0.5)
        .FooterMargin = xl.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = Excel.xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        If Orient = "P" Then myOrient = Excel.xlPortrait Else If Orient = "L" Then myOrient = Excel.xlLandscape
        .Orientation = myOrient
        .Draft = False
        .PaperSize = Excel.xlPaperLetter
        .FirstPageNumber = Excel.xlAutomatic
        .Order = Excel.xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintTitleRows = RepeatRows
     End With
   End With
   xl.ScreenUpdating = True
ExitSub:
  Exit Sub
ErrHand:
  Response = MsgBox("Error Number: " & Err.Number & vbCr & "Description: " & Err.Description, vbInformation, "Error Handler")
  Resume ExitSub
End Sub
 
Upvote 0
get rid of
Dim xl As Excel.Application
and change all
xl. stuff
to
ws.Application. stuff
so
xl.InchesToPoints
becomes
ws.Application.InchesToPoints
 
Upvote 0
James,
Perfect...thanks...i appreciate your help...

Any thoughts on the questions in post #5 above? just more of an FYI for myself...thanks...
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,142
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top