Question

这里我有一些VBA代码可以将大量文件输出到Excel文件中。我的问题是，从这里，它有没有格式化excel文件？我想要做的是使列变粗，并使列符合标题的大小。

Sub OutPutXL()


Dim qdf As QueryDef
Dim rs As DAO.Recordset

Set qdf = CurrentDb.QueryDefs("OutputStudents")
Set rs = CurrentDb.OpenRecordset("Teachers")

Do While Not rs.EOF
qdf.SQL = "SELECT * FROM Students WHERE contact='" & rs!contact & "'"

''Output to Excel
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
qdf.Name, "C:\Users\chrisjones\Documents\ProjectionsFY14\Teachers\" _
& rs!contact & ".xls", True
rs.MoveNext
Loop

End Sub

Answer 1

这是Phil.Wheeler的Code和我之前输入的快速而又脏的组合，对我来说这是有效的。不要忘记在Access-Macro中添加Excel的对象库。

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

Answer 2

我也遇到过这个问题几次。正如@Remou所说，你需要打开excel来格式化xls文件，这段代码的修改会默默地打开Excel，这应该会让你朝着正确的方向前进。请记住在VBA项目中添加对Microsoft Excel对象库的引用。

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

Answer 3

是的，这是可能的！这是从我的一个代码一起被黑客入侵，可能需要在它工作之前进行一些编辑...

'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...

Answer 4

您可以（根据文件数量）为您要输出的每个文件创建一个模板。从长远来看，如果有人需要更改格式，他们可以更改模板，这对您来说更容易，因为您不必筛选一堆excel格式化垃圾。您甚至可以让合格的最终用户执行此操作。

这是我在excel工作表中遇到的最大问题之一，如果我写了VBA，我负责直到我为此而死。这种方式（理论上）他们应该能够在不改变数据输出方式的情况下更改列，只是在没有你的情况下呈现。

+1要打开excel文件本身并使用该自动化格式化它。

使用VBA格式化Access中输出的Excel文件？

4 个答案: