将带有VBScript的4列插入Excel

时间:2017-06-07 12:51:20

标签: excel vbscript

我想创建一个打开工作簿并对其进行格式化的VBScript。代码有效。唯一不起作用且我不确定如何操作的是在B列中插入4列。我如何在B中添加4列,并以正确的方式移动其余的单元格?

    Option Explicit
    Dim objExcel, x
    Dim LastRow
    Const xlContinuous = 1
    Const xlUp = -4162
    Const xlGeneral = 1
    Const xlBottom =1
    Const xlCenter = 1
    Const xlLeft = 1 
    Const xlShiftToRight = -4161


    Set objExcel = CreateObject("Excel.Application")
    With objExcel
        .Workbooks.Open ("C:\Users\STELIOS\Frank\paper5.xls")
        .Visible = False
        .Rows("1:2").Delete

        Set objRange = objExcel.Range("B1").EntireColumn
        objRange.Insert(xlShiftToRight) 

        Set objRange = objExcel.Range("B1").EntireColumn
        objRange.Insert(xlShiftToRight)

        Set objRange = objExcel.Range("B1").EntireColumn
        objRange.Insert(xlShiftToRight)

        Set objRange = objExcel.Range("B1").EntireColumn
        objRange.Insert(xlShiftToRight)

        LastRow = .Range("A1048576").End(xlUp).Row
        .Range("G1:" & "G" & LastRow).Copy
        .Range("B1").Select
        .ActiveSheet.Paste
        Do While LastRow <>0
            .Cells(LastRow,2)="*"&.Cells(LastRow,3)&"*"
            LastRow = LastRow - 1
        Loop
        LastRow = .Range("A1048576").End(xlUp).Row
        .Range("F1:" & "F" & LastRow).Copy
        .Range("C1").Select
        .ActiveSheet.Paste
        Do While LastRow <>0
            .Cells(LastRow,2)="*"&.Cells(LastRow,3)&"*"
            LastRow = LastRow - 1
        Loop
        .Cells.Font.Size=9
        .Columns("B:B").Font.Name = "Free 3 of 9"
        .Columns("B:B").Font.Name = "Arial"
        .Columns("B:B").Font.Size = 24

        .Rows("1:1").Font.Name = "Arial"
        .Rows("1:1").Font.Size = 9
        LastRow = .Range("A1048576").End(xlUp).Row
        .Range("H1:" & "H" & LastRow).Copy
        .Range("D1").Select
        .ActiveSheet.Paste
        Do While LastRow <>0
            .Cells(LastRow,2)="*"&.Cells(LastRow,3)&"*"
            LastRow = LastRow - 1
        Loop
        LastRow = .Range("A1048576").End(xlUp).Row
        .Range("I1:" & "I" & LastRow).Copy
        .Range("E1").Select
        .ActiveSheet.Paste
        Do While LastRow <>0
            .Cells(LastRow,2)="*"&.Cells(LastRow,3)&"*"
            LastRow = LastRow - 1
        Loop
        .Columns("F:O").Delete
        .Range("B1").Select
            .ActiveCell.FormulaR1C1 = "Barcode"
        .Columns("A:A").ColumnWidth = 2.71
        .Columns("B:B").ColumnWidth = 22.14
        .Range("A1:E1").Borders.LineStyle = xlContinuous
        .Columns("D:D").ColumnWidth = 36.8
        .Columns("C:C").ColumnWidth = 13.57
        .Range("A:A").HorizontalAlignment = -4131
        .Range("A:A").VerticalAlignment = -4108
        .Cells.RowHeight = 25.5
        .Rows("1:1").RowHeight = 16.5
        .Rows("1:1").VerticalAlignment = -4108
        .Range("B:B").HorizontalAlignment = -4108
        .Range("C:C").VerticalAlignment = xlBottom
        .Range("C:C").VerticalAlignment = -4108
        .Range("C:C").HorizontalAlignment = -4108
        .Range("C:C").HorizontalAlignment = -4108
        .Range("F:F").VerticalAlignment = xlBottom
        .Range("F:F").VerticalAlignment = -4108
        .Range("F:F").HorizontalAlignment = -4108
        .Range("D:D").VerticalAlignment = xlBottom
        .Range("D:D").VerticalAlignment = -4108
        .Range("E:E").VerticalAlignment = xlBottom
        .Range("E:E").VerticalAlignment = -4108
        .ActiveWorkbook.PrintOut
        .ActiveWorkbook.Close(False)
        .Quit
    End With

0 个答案:

没有答案