1

在这里，我有一些 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
4

4 回答 4

2

这是 Phil.Wheeler 的代码和我之前的输入的快速而肮脏的组合，对我来说这是有效的。不要忘记在 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
于 2013-01-18T14:45:07.803 回答
1

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...
于 2013-06-26T10:47:30.540 回答
1

我也遇到过几次这个问题。正如@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
于 2013-01-21T01:04:03.657 回答
0

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

如果我编写了我负责的 VBA，直到我为此而死，这是我使用 excel 表时遇到的最大问题之一。这样（理论上）他们应该能够更改列，而无需更改数据的输出方式，只是在没有您的情况下呈现。

+1打开excel文件本身并使用该自动化对其进行格式化。

于 2013-01-22T13:39:13.847 回答