Consulting

Results 1 to 2 of 2

Thread: Solved: Excel borders from Access with VBA

  1. #1

    Solved: Excel borders from Access with VBA

    Excuse the sloppy code. But this is my feeble attempt at trying to format borders into an Excel spreadsheet from Access. Eventually I am going to populate the spreadsheet with queries from a table in Access but for now since I'm still new to VBA I am sticking with formatting and such. So this is what I have so far is there anyone that can point me in the right direction. I appreciate any and all insight. Thanks you.


    Private Sub Command185_Click()
    
    'Application.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "LexingtonCommissions", "C:\Book1.xls", False, ""
        
    'Attempt to bind to an open instance
    Dim xlApp As Object
    Dim ExcelRunning As Boolean
    Dim XLDoc As Object
    Dim r As Object
    Dim objsheets As Object
    'Dim xlEdgeBottom As Object
    Dim xlcontinuous As Object
    'Dim xlThin As Object
    Const xlEdgeBottom = 9
    Const xlThin = 2
    Const xlDouble = -4119
    Const xlThick = 4
                
                
    
    'Check if excel is open if not open in instance
    ExcelRunning = IsExcelRunning()
    If ExcelRunning Then
        Set xlApp = GetObject(, "Excel.Application")
    Else
        Set xlApp = CreateObject("Excel.Application")
    End If
    
    
    'If Not ExcelRunning Then xlApp.Quit
    'Set xlApp = Nothing
    
    'Opening document in excel
    'Set XLDoc = xlApp.workbooks.Open("c:\test.xls")
    'xlApp.workbooks.Open FileName:="c:\test.xls", ReadOnly:=True
    xlApp.Visible = True
    Set objsheets = xlApp.workbooks.Add
    
    'Format the headers
    xlApp.Range("A2:D6").Font.Bold = True
    'xlApp.Range("A1:R1").HorizontalAlignment = xlCenter
    xlApp.Range("A2:D6").Font.ColorIndex = 2
    xlApp.Range("A2:D6").Interior.ColorIndex = 1
    
    'xlApp.Range("A2:D6").ActiveCell.Borders(2).Color = RGB(0, 0, 0)
    
    
    'xlApp.Cells(1, 1).Borders(xlEdgeBottom).Weight = xlThick
    'xlApp.Cells(1, 1).Borders(xlEdgeBottom).ColorIndex = 5
    'xlApp.Cells(1, 1).Borders(xlEdgeBottom).LineStyle = xlDouble
    
    
    'xlApp.Range("A2:D6").Borders(xlEdgeBottom).LineStyle = xlcontinuous
    'xlApp.Range("A2:D6").Borders(xlEdgeBottom).Weight = xlThin
    
    
    'AutoFit the columns
    xlApp.Range("A:R").Columns.AutoFit
    
    'Freeze Panes
    'xlApp.Activate
    xlApp.Range("2:2").Select
    xlApp.ActiveWindow.FreezePanes = True
    
    'Set the cursor back on the first cell
    xlApp.Range("A1:A1").Select
    
    
    
    
    Exit_Command185_Click:
        Exit Sub
    
    Err_Command185_Click:
        MsgBox Err.Description
        Resume Exit_Command185_Click
        
    End Sub

  2. #2
    I'm going to go ahead and solve my own problem.

    [VBA]Dim xlapp As Object
    Dim wk As Object
    Dim xlSheet As Object
    Dim sheetname
    Dim r As Object


    sheetname = "New Sheet Name"
    Set xlapp = CreateObject("Excel.Application")


    xlapp.Workbooks.Add
    xlapp.Worksheets(1).Name = sheetname

    xlapp.Visible = True
    Set r = xlapp.Worksheets(sheetname).Range("A2:Z2")

    With r
    .Borders.Weight = 4
    .Value = "Done!"
    End With
    [/VBA]

    I'm guessing I had no replies either because I pasted all of my messy code instead of just the portion I was trying to solve or that this was so easy of a problem that no one bothered wasting keystrokes. Oh well at least its solved.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •