|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub ChangAnBuYi()
'长安布衣 mrttl@hotmail.com
'时间: 2009-9-12
'
On Error GoTo myEnd
Dim myPath As String
If Cells(3, 2).Value <> "长安布衣" Then
Exit Sub
End If
Application.ScreenUpdating = False
myPath = ActiveWorkbook.Path
Workbooks.OpenText Filename:=[myPath] & "/" & "成绩.txt", Origin:=936, StartRow:=1 _
, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
Range("A1:L1").Select
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
With Selection.Font
.ColorIndex = 2
.Bold = True
.Bold = True
End With
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 10
End With
Range("A1").Select
Columns("J:J").EntireColumn.AutoFit
Columns("K:L").EntireColumn.AutoFit
Sheets("成绩").Copy after:=Workbooks("长安布衣_成绩.xls").Sheets(1)
Workbooks("成绩.txt").Close savechanges:=False
myLast = Range("A65536").End(xlUp).Row + 1
myLast_1 = myLast - 1
myRange1 = "A" & [myLast] & ":L" & [myLast]
myRange2 = "B" & [myLast] & ":I" & [myLast]
myRange3 = "A" & [myLast]
myRange4 = "B" & [myLast]
Range(myRange1).Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range(myRange3).FormulaR1C1 = "合计"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.Size = 10
End With
Range(myRange4).Formula = "=SUM(B2:B" & [myLast_1] & ")"
Range(myRange4).Copy Range(myRange2)
Range("A2").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 75
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A1").Select
myEnd:
Application.ScreenUpdating = True
End Sub |
|
楼主: 长安布衣
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-9-6 15:23
楼主
