Formatting outputted Excel files from Access using VBA?

后端 未结 4 634
面向向阳花
面向向阳花 2021-01-03 17:01

Here I have some VBA code that outputs a ton of files into Excel files. My question is, from this, is there anyway for it to Format the excel file a bit? What I would like t

相关标签:
4条回答
  • 2021-01-03 17:02

    this is a quick and dirty combination of Phil.Wheeler's Code and my previous input, for me this is working. Don't forget to add Excel's Object Library in your Access-Macro.

    Sub doWhatIWantTheDirtyWay()
    
    pathToFolder = "C:\Users\Dirk\Desktop\myOutputFolder\"
    scaleFactor = 0.9
    
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    objExcel.DisplayAlerts = False
    
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(pathToFolder)
    
    For Each objFile In objFolder.Files
        If objFso.GetExtensionName(objFile.path) = "xls" Then
             Set objWorkbook = objExcel.Workbooks.Open(objFile.path)
             For Each sh In objWorkbook.Worksheets
    
                If sh.UsedRange.Address <> "$A$1" Or sh.Range("A1") <> "" Then
                    With sh
                        columncount = .Cells(1, 256).End(xlToLeft).Column
                        For j = 1 To columncount
    
                            With .Cells(1, j)
                                i = Len(.Value)
                                .ColumnWidth = i * scaleFactor
                                .Font.Bold = True
                            End With
                        Next
                    End With
                End If
             Next
             objWorkbook.Close True
        End If
    Next
    
    objExcel.Quit
    
    
    
    End Sub
    
    0 讨论(0)
  • 2021-01-03 17:07

    You could (depending on the number of files) make a template for each file you are outputting. In the long run if someone needs to change the formatting they can change the template which is going to be easier on you now that you don't have to sift through a bunch of excel formatting garbage. You could even let a qualified end user do it.

    It's one of the biggest problems I have with excel sheets if I wrote the VBA I am responsible until I die for it. This way (in theory) they should be able to change a column, without changing how the data is outputted, just presented without you.

    +1 To open the excel file itself and format it using that automation though.

    0 讨论(0)
  • 2021-01-03 17:18

    Yes it is possible! This is hacked together from one of my codes, might need a bit of editing before it works...

    'This deals with Excel already being open or not
    On Error Resume Next
    Set xl = GetObject(, "Excel.Application")
    On Error GoTo 0
    If xl Is Nothing Then
      Set xl = CreateObject("Excel.Application")
    End If
    
    Set XlBook = GetObject(filename)
    'filename is the string with the link to the file ("C:/....blahblah.xls")
    
    'Make sure excel is visible on the screen
    xl.Visible = True
    XlBook.Windows(1).Visible = True
    'xl.ActiveWindow.Zoom = 75
    
    'Define the sheet in the Workbook as XlSheet
    Set xlsheet1 = XlBook.Worksheets(1)
    
    'Then have some fun!
    with xlsheet1
        .range("A1") = "some data here"
        .columns("A:A").HorizontalAlignment = xlRight
        .rows("1:1").font.bold = True
    end with
    
    'And so on...
    
    0 讨论(0)
  • 2021-01-03 17:18

    I have come across this problem a couple of times as well. As @Remou said, you will need to open excel to format xls files, this modification of your code silently opens Excel and that should get you in the right direction. Remember to add a reference to the Microsoft Excel Object Library in your VBA project.

    Sub OutPutXL()
    Dim qdf As QueryDef
    Dim rs As DAO.Recordset
    Dim xl as Excel.Application
    Dim wb as Object
    Dim strFile as string
    
    Set qdf = CurrentDb.QueryDefs("OutputStudents")
    Set rs = CurrentDb.OpenRecordset("Teachers")
    Set xl = New Excel.Application
    xl.DisplayAlerts = False
    
    Do While Not rs.EOF
        qdf.SQL = "SELECT * FROM Students WHERE contact='" & rs!contact & "'"
    
        'Output to Excel
        strFile = "C:\Users\chrisjones\Documents\ProjectionsFY14\Teachers\" & rs!contact & ".xls"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, qdf.Name, strFile, True
    
        'Start formatting'
        Set wb = xl.Workbooks.Open(strFile)
        With wb.Sheets(qdf.name)
            'Starting with a blank excel file, turn on the record macro function'
            'Format away to hearts delight and save macro'
            'Past code here and resolve references'
        End With
        wb.save
        wb.close
        set wb = Nothing
        rs.MoveNext
    Loop
    xl.quit
    set xl = Nothing
    End Sub
    
    0 讨论(0)
提交回复
热议问题