使用VBA使用个人工作簿宏打开另一个Excel文件

时间:2016-05-20 18:38:28

标签: vba excel-vba excel

我有一个格式化报告的宏。我想在我的个人工作簿中包含此宏,但是代码的一部分引用了第二个工作簿并从该工作簿复制格式。宏只是部分工作(一些工作表没有按照我想要的方式格式化)使用个人工作簿,我认为它完全没有用,因为我引用了另一个工作簿。当我自己运行宏时,一切正常。我的代码中是否有我遗漏的东西?

Sub Format()
    Sheets(Sheets.Count).Move Before:=Sheets(1)
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        Rows("1:11").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Rows("12:12").Select
        Selection.Font.Bold = True
        Selection.AutoFilter
        Cells.Select
        Cells.EntireColumn.AutoFit
        ws.Range("A4") = ws.Name
        Range("A4").Select
        Selection.Font.Bold = True
        On Error Resume Next
        Sheets(ActiveSheet.Index + 1).Activate
        If Err.Number <> 0 Then Sheets(1).Activate
    Next ws


    Range("D13:E222").Select
    Selection.ClearContents

    xlApp.Workbooks.Open FileName:="C:\Automation\Format.xlsm"
    Sheets("All_Leadsheet").Select

    Range("A1:O233").Select
    Selection.Copy
    ActiveWorkbook.Activate
    Range("A1:N471").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("A1").Select


    Columns("A:F").Select
    Selection.ColumnWidth = 40
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True '!!!!!!!!!!!!!!!!!!!!!
        .Orientation = 0
    End With

    Windows("Format.xlsm").Close savechanges:=False

1 个答案:

答案 0 :(得分:0)

我相信你遇到的主要问题是你引用了sheet()和range()而没有指定它们所在的位置,因此VBA正在猜测。而且我猜测VBA正在猜测个人工作簿及其工作表,而不是您想要执行操作的工作簿。

我不得不猜测你在这里所做的一些事情,但你应该从我的改变中拿走的主要事情是你不需要在改变之前选择一个细胞。我猜这是来自你录制宏(顺便学习的好方法)。但这会降低你的宏速度,只有当你真正需要它时才选择它。这实际上也适用于纸张,您不必让纸张处于活动状态以对其进行更改。希望这会有所帮助。

Sub Format()

Dim wb As Workbook

Set wb = ActiveWorkbook

wb.Sheets(Sheets.Count).Move Before:=Sheets(1)
wb.Sheets("not sure which sheet you want").Rows("1:1").Delete 'Shift:=xlUp

Dim ws As Worksheet
For Each ws In wb.Worksheets
    ws.Activate
    ws.Rows("1:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With ws.Rows("12:12")
        .Font.Bold = True
        .AutoFilter
    End With
    ws.Cells.EntireColumn.AutoFit
    ws.Range("A4") = ws.Name
    Range("A4").Font.Bold = True
    'On Error Resume Next 'Careful with these, all your errors will now just resume next
    'Sheets(ActiveSheet.Index + 1).Activate 'Next ws takes care of this, unless you are wanting to skip two worksheets
    'If Err.Number <> 0 Then Sheets(1).Activate
Next ws

Set ws = wb.Sheets(1)
ws.Activate

ws.Range("D13:E222").ClearContents

xlApp.Workbooks.Open Filename:="C:\Automation\Format.xlsm" 'Where is xlApp set at?


Set ws = Sheets("All_Leadsheet")

ws.Range("A1:O233").Copy
'ActiveWorkbook.Activate 'active workbook should already be active
ws.Range("A1:N471").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'ws.Range("A1").Select


With ws.Columns("A:F")
    .ColumnWidth = 40
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = True '!!!!!!!!!!!!!!!!!!!!!
    .Orientation = 0
End With

Windows("Format.xlsm").Close savechanges:=False 'Not sure what this file is? Perhaps the individual file before
                                                'moving it to personal workbook? If so delete this.
End Sub