Sub 借书记录()
On Error Resume Next
'删除对象和超链接；
For Each sps In ActiveSheet.Shapes
sps.Delete
Next sps
For Each hlk In ActiveSheet.Hyperlinks
hlk.Delete
Next hlk
'单元格格式化（取消换行、列宽设置）
Cells.Select
Cells.EntireColumn.AutoFit
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns('C:C').ColumnWidth = 30
Columns('D:D').ColumnWidth = 23
Columns('G:G').ColumnWidth = 12
Columns('I:I').ColumnWidth = 8
Selection.HorizontalAlignment = xlLeft
Columns('A:A').Select
Selection.HorizontalAlignment = xlCenter
Columns('B:B').Select
Selection.HorizontalAlignment = xlRight
Selection.NumberFormatLocal = '0.00_);[红色](0.00)'
Selection.NumberFormatLocal = '0_);[红色](0)'
Columns('B:B').EntireColumn.AutoFit
Columns('I:I').Select
Selection.HorizontalAlignment = xlCenter
Columns('F:F').Select
Selection.HorizontalAlignment = xlCenter
Range('A1:I1').Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'B列最后一个非空单元格；
Dim Lrow As Long
Lrow = Range('B' & Cells.Rows.Count).End(xlUp).Row
'区域格式化
Range('A1:I' & Lrow).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlHairline
End With
Range('D2').Select
ActiveWindow.FreezePanes = True
Range('A1').Select
ActiveCell.FormulaR1C1 = 'sn'
Range('A2').Select
ActiveCell.FormulaR1C1 = '1'
Range('A3').Select
ActiveCell.FormulaR1C1 = '2'
Range('A2:A3').Select
Selection.AutoFill Destination:=Range('A2:A' & Lrow), Type:=xlFillDefault
Columns('A:A').EntireColumn.AutoFit
ActiveSheet.Name = Year(Date) & '-' & Month(Date) & '-' & Day(Date)
'表格未尾数据处理
Dim cell1 As Range
Dim cell2 As Range
Dim countn As Long
Dim n As Long
n = 0
countn = 0
For Each cell1 In ActiveSheet.Range('c2:C' & Lrow)
For Each cell2 In ActiveSheet.Range('c2:C' & Lrow)
If cell2.Value = cell1.Value Then countn = countn + 1
Next cell2
n = n + 1
Next cell1
Range('C' & Lrow + 1).Value = '共借书本数：' & Lrow - 1 - (countn - n) / 2 & '本'
Range('H19').Select
Range('H' & Lrow + 1).FormulaR1C1 = '=MIN(R2C:R[-1]C)'
Range('H' & Lrow + 1).Select
ActiveCell.Offset(, -1).Value = '最近需还书日期：'
ActiveCell.Offset(, -1).HorizontalAlignment = xlRight
If (countn - n) / 2 > 0 Then
ActiveCell.Offset(1, -5).Value = '应该包含的光盘个数：' & (countn - n) / 2 & '个'
Else
ActiveCell.Offset(1, -5).Value = '没有光盘！'
End If
ActiveCell.Offset(1, 1).Value = '700开头的条码是白云区图书馆的图书；其它是广图的图书；'
ActiveCell.Offset(1, 1).HorizontalAlignment = xlRight
Dim dayn As Integer
dayn = Range('H' & Lrow + 1).Value - Date
ActiveCell.Offset(, 1).Value = '(' & dayn & '天后到期!)'
ActiveCell.Offset(, 1).HorizontalAlignment = xlLeft
Columns('H:H').Select
Columns('H:H').EntireColumn.AutoFit
End Sub
