VBS格式化每个Excel文件

时间:2014-04-30 20:05:14

标签: excel vba vbscript

我需要一个VBS来格式化指定文件夹中的所有Excel文件。

实际上这个脚本每天都会在不同的文件夹中运行。如果系统日期是2014/01/02,那么它应该转到名为c:\ xxx \ 20140102的文件夹并在每个excel文件上运行。

我在excel中记录的宏是这样的;

   Sub ACLDUZELT2()
'
' ACLDUZELT2 Macro
'

'
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.Font.Bold = True
    Rows("1:4000").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("A:CS").Select
    Columns("A:CS").EntireColumn.AutoFit
    Range("A1").Select
    ActiveWorkbook.Save
End Sub

当然,文件必须像这种格式一样保存。

谢谢。

3 个答案:

答案 0 :(得分:0)

您可以使用FileSystemObject执行此操作,基本上您只想在特定FileFolder个对象的循环内调用宏。

Sub RunStuff()
Dim path As String
path = "C:\xxx\" & Format(Now(),"YYYYMMDD")  '## Modify as needed

Dim fldr as Object
Dim fl as Object
Dim wb as Workbook

With CreateObject("Scripting.FileSystemObject")
    Set fldr = .GetFolder(path)
    For each fl in fldr.Files
        Set wb = Workbooks.Open(fl.Name)
        wb.Activate
        Call ACLDUZELT2
    Next
End With

Set fldr = Nothing
Set fl = Nothing

答案 1 :(得分:0)

如果要从VBScript调用Excel宏,则需要在Excel对象上使用Run method

在这个脚本中,我假设您的宏保存在名为“MyMacroFile.xlsm”的Excel文件中,并且您要处理的文件位于名为“xlfiles”的文件夹中。

Set xl = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Set folder = fs.GetFolder(".\xlfiles")

xl.Visible = True
xl.Workbooks.Open "MyMacroFile.xlsm"
For Each file In folder.Files
    If Right(file.Name, 5) = ".xlsx" Then
        Set wb = xl.Workbooks.Open(file.Name)
        xl.Run "'MyMacroFile.xlsm'!ACLDUZELT2"
        wb.Save
        wb.Close
    End If
Next

xl.Quit

答案 2 :(得分:0)

谢谢你的一切。事实上,我把你的答案的最佳部分,并创建了一个有效的vbs脚本。

    On Error Resume Next
Set objFiles = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")

Dim strNow, strDD, strMM, strYYYY, strFulldate
strYYYY = DatePart("yyyy",Now())
strMM = Right("0" & DatePart("m",Now()),2)
strDD = Right("0" & DatePart("d",Now()),2)

Dim strbugun 
strbugun=strYYYY & strMM & strDD

Dim path2
path2="C:\xxx\deneme\" & strbugun
Set folder = fs.GetFolder(path2)
Dim path

For Each file In folder.Files


path = path2 & "\" & file.Name

Set oxl = CreateObject("Excel.Application")
Set owb = oxl.Workbooks.Open (path)

    Set ows = owb.worksheets(1)
    ows.activate
    With ows
    .range("A1:CS1").Font.Bold = True
    .range("A1:CS4000").Font.Name = "Arial"
    .range("A1:CS4000").Font.Size = 10
    .columns("A:CS").EntireColumn.autofit
    End With


    Set ows2 = owb.worksheets(2)
    ows2.activate
    With ows2
    .range("A1:CS1").Font.Bold = True
    .range("A1:CS4000").Font.Name = "Arial"
    .range("A1:CS4000").Font.Size = 10
    .columns("A:CS").EntireColumn.autofit
    End With

    owb.save
    owb.close

Next