VBS。将标题添加到特定Excel文档

时间:2017-04-25 14:01:21

标签: excel vba excel-vba vbscript

我正在尝试修改下面的代码,因此它会将标题添加到特定的Excel文档中,并在添加标题后将其关闭。脚本一直在第二行死亡,而且是vba的新手我不知道我做错了什么

Sub AddHeaders()

    Dim headers() As Variant
    Dim ws As Worksheet
    Dim wb As Workbook

    Application.ScreenUpdating = False 'turn this off for the macro to run a little faster

    Set wb = "C:\Users\aallen\Documents\Reports\PW Infor\pw.xlsx"

    headers() = Array("Superhero", "City", "State", "Country", "Publisher", "Demographics", _
        "Planet", "Flying Abilities", "Vehicle", "Sidekick", "Powers")
    For Each ws In wb.Sheets
        With ws
        .Rows(1).Value = "" 'This will clear out row 1
        For i = LBound(headers()) To UBound(headers())
            .Cells(1, 1 + i).Value = headers(i)
        Next i
        .Rows(1).Font.Bold = True
        End With
    Next ws

    Application.ScreenUpdating = True 'turn it back on

    MsgBox ("Done!")

End Sub

1 个答案:

答案 0 :(得分:0)

首先,我们需要说问题的代码是VBA,但@AlexAllen想用VBScript做。所以我们现在有两种不同的方法。

1。方法:VBA

您应该使用Workbooks.Open Method

Workbooks.Open Filename:=PathName & Filename

在你的情况下

Set wb = Workbooks.Open(Filename:="C:\Users\aallen\Documents\Reports\PW Infor\pw.xlsx")

独立于用户名并始终从您可以使用的当前用户文件夹中加载

Set wb = Workbooks.Open(Filename:=Environ("userprofile") & "\Documents\Reports\PW Infor\pw.xlsx")

旁注:

  • 不要忘记使用wb.Close SaveChanges:=True关闭工作簿。
  • 我还建议您使用Option Explicit,这样您就不会忘记使用iDim i as Long)声明任何变量。

所以我们最终......

Sub AddHeaders()
    Dim headers() As Variant
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim i as Long

    Application.ScreenUpdating = False 'turn this off for the macro to run a little faster

    Set wb = Workbooks.Open(Filename:="C:\Users\aallen\Documents\Reports\PW Infor\pw.xlsx")

    headers() = Array("Superhero", "City", "State", "Country", "Publisher", "Demographics", _
        "Planet", "Flying Abilities", "Vehicle", "Sidekick", "Powers")
    For Each ws In wb.Sheets
        With ws
            .Rows(1).Value = "" 'This will clear out row 1
            For i = LBound(headers()) To UBound(headers())
                .Cells(1, 1 + i).Value = headers(i)
            Next i
            .Rows(1).Font.Bold = True
        End With
    Next ws

    wb.Close SaveChanges:=True

    Application.ScreenUpdating = True 'turn it back on

    MsgBox ("Done!")
End Sub

2。方法:VBScript

call AddHeaders

Sub AddHeaders()
    Dim xlApp, xlWbk, xlSht
    Dim headers 
    Dim i

    Set xlApp = CreateObject("Excel.Application")
    xlApp.DisplayAlerts = False 'we should prevent any alerts from excel so nothing stops that script.
    xlApp.ScreenUpdating = False 'turn this off for the macro to run a little faster

    Set xlWbk = xlApp.Workbooks.Open("C:\Users\aallen\Documents\Reports\PW Infor\pw.xlsx")

    headers = Array("Superhero", "City", "State", "Country", "Publisher", "Demographics", _
            "Planet", "Flying Abilities", "Vehicle", "Sidekick", "Powers")
    For Each xlSht In xlWbk.Sheets
        With xlSht
            .Rows(1).Value = "" 'This will clear out row 1
            For i = LBound(headers) To UBound(headers)
                .Cells(1, 1 + i).Value = headers(i)
            Next
            .Rows(1).Font.Bold = True
        End With
    Next

    xlWbk.Close (True)
    xlApp.Quit

    xlApp.ScreenUpdating = True
    MsgBox ("Done!")

    'always deallocate after use...
    Set xlSht = Nothing
    Set xlWbk = Nothing
    Set xlApp = Nothing
End Sub