宏在重新运行时越来越多

时间:2015-02-12 17:36:07

标签: vba loops

无法在宏下面重新运行有没有人知道它为什么会在文件位置中断?

还有人知道如何循环此宏来获取更多工作簿中的工作表吗? 尝试从工作簿2中拾取工作表并以下面的方式格式化它们。

Sub specalign()
'
' specalign Macro
'

'
    Workbooks.Open Filename:= _
        "C:\\\\Interface Specifications Master v7 7.xlsx"
    Sheets("1.1.1").Select
    Sheets("1.1.1").Move After:=Workbooks( _
        "Interface Specifications Master v7.8.xlsx").Sheets(2)
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft
    Range("N1").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.ClearContents
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1:N1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("Table1[[#Headers],[Spec ID]]").Select
    Selection.AutoFilter
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("Table1[[#Headers],[Spec ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A3:B3,G3:M3").Select
    Range("Table1[[#Headers],[  Conditionality ]]").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("3:3").RowHeight = 108.75
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").ColumnWidth = 8#
    Columns("B:B").ColumnWidth = 8#
    Columns("C:C").ColumnWidth = 34#
    Columns("D:D").ColumnWidth = 22#
    Columns("E:E").ColumnWidth = 17#
    Columns("G:G").ColumnWidth = 8#
    Columns("H:H").ColumnWidth = 22
    Columns("I:I").ColumnWidth = 8#
    Columns("J:J").ColumnWidth = 8#
    Columns("K:K").ColumnWidth = 8
    Columns("L:L").ColumnWidth = 6#
    Columns("M:M").ColumnWidth = 10
    
    
    End Sub

1 个答案:

答案 0 :(得分:0)

关于@nickslash说你的文件名看起来像是这个问题。 但是,你可以做很多事情来改进这些代码,比如去除scrollcolumns和所有选择。

要获取文件路径,您可以右键单击文件夹中的文件,然后选择属性。 >在常规选项卡上选择位置。然后,您将看到您需要的路径。

当你学习vba时,你会比我在这里做得更好。并选择文件并使其更具动态性(可能会提示选择您想要的文件,如jean演示here)。

更新如下:

Sub specalign()
Dim ws As Worksheet

Dim wb1 As Workbook
Dim wb2 As Workbook

'this is what mine looks like with the directory
Set wb1 = Workbooks.Open("C:\Users\james\Documents\Interface Specifications Master v7.8.xlsx") 'target workbook .8 I kept
Set wb2 = Workbooks.Open("C:\Users\james\Documents\Interface Specifications Master v7 7.xlsx")  'source workbook


For Each ws In wb2.Worksheets
    ws.Copy after:=wb1.Worksheets(2)
Next