这几天公司有个报表开发需求,UI要求也相当高,讨论决定使用excel模版来做报表需求。
报表开发主要使用宏,后端是JAVA调用POI进行隐藏sheet的数据填充,最后执行宏绘制报表。
宏如下:
Sub auto_Open()
Sheets("i18n").Select
v = Range("B2").Value
If v = 0 Then
TravellerReprot
Sheets("i18n").Select
Range("B2").Value = 1
Sheets("Traveller Anlysis Report").Select
ActiveWorkbook.Save
End If
Sheets("Traveller Anlysis Report").Select
End Sub
Rem 差旅人报表数据
Sub TravellerReprot()
'------------------------常量定义------------------------
'预留行数
Const limitNum = 23
'数据开始行数
Const startNum = 7
'en_US
Const en_US_TitleMain = "Business Travel Account"
Const en_US_TitleMain2 = "Traveler Analysis Report For 2012-01-01 To 2012-03-01"
Const en_US_AccountName = "Account Name:"
Const en_US_AccountNumber = "Account Number:"
Const en_US_GenerationDate = "Generation Date:"
Const en_US_Traveler = "Traveler"
Const en_US_Class = "Class"
Const en_US_Routing = "Routing"
Const en_US_DeptDate = "Dept Date"
Const en_US_TicketNumber = "Ticket Number"
Const en_US_ValueRMB = "Value RMB"
Const en_US_BottomName = "This is a management information report and is not to be used for accounting purposes"
Const en_US_Page = "Page Number 1 Of 1"
Const en_US_TotalReport = "Report Totals"
'zh_CN
Const zh_CN_TitleMain = "商务旅行账户"
Const zh_CN_TitleMain2 = "员工差旅分析(2012-01-01 到 20120-03-01)"
Const zh_CN_AccountName = "企业名称:"
Const zh_CN_AccountNumber = "企业编号:"
Const zh_CN_GenerationDate = "报表生成日期:"
Const zh_CN_Traveler = "差旅人"
Const zh_CN_Class = "舱位"
Const zh_CN_Routing = "航程"
Const zh_CN_DeptDate = "起飞/交易日期"
Const zh_CN_TicketNumber = "票号"
Const zh_CN_ValueRMB = "交易金额"
Const zh_CN_BottomName = "这是一个管理信息报告且不被用于会计目的"
Const zh_CN_Page = "第1页 共1页"
Const zh_CN_TotalReport = "报表总计"
'------------------------逻辑处理------------------------
Application.ScreenUpdating = False
'1.i18n初始化
Sheets("i18n").Select
lang = Range("B1").Value
Debug.Print "语言选择为" & lang
Debug.Print "初始化国际化信息"
Sheets("Traveller Anlysis Report").Select
If lang = "en_US" Then
Range("C1").Value = en_US_TitleMain
Range("B2").Value = en_US_TitleMain2
Range("A4").Value = en_US_AccountName
Range("C4").Value = en_US_AccountNumber
Range("E4").Value = en_US_GenerationDate
Range("A6").Value = en_US_Traveler
Range("B6").Value = en_US_Class
Range("C6").Value = en_US_Routing
Range("D6").Value = en_US_DeptDate
Range("E6").Value = en_US_TicketNumber
Range("F6").Value = en_US_ValueRMB
Range("B32").Value = en_US_BottomName
Range("C33").Value = en_US_Page
Else
Range("C1").Value = zh_CN_TitleMain
Range("B2").Value = zh_CN_TitleMain2
Range("A4").Value = zh_CN_AccountName
Range("C4").Value = zh_CN_AccountNumber
Range("E4").Value = zh_CN_GenerationDate
Range("A6").Value = zh_CN_Traveler
Range("B6").Value = zh_CN_Class
Range("C6").Value = zh_CN_Routing
Range("D6").Value = zh_CN_DeptDate
Range("E6").Value = zh_CN_TicketNumber
Range("F6").Value = zh_CN_ValueRMB
Range("B32").Value = zh_CN_BottomName
Range("C33").Value = zh_CN_Page
End If
'2.是否增行判断:有效数据行数与预留行数对比
Sheets("data").Select
activeNum = Range("A65536").End(xlUp).Row
Debug.Print "有效数据行数为" & activeNum
totalTraveller = Range("A" & activeNum).Value
Debug.Print "差旅人总数为" & totalTraveller
If activeNum > limitNum Then
Debug.Print "有效数据行数大于预留行数,进行增行操作"
insertNum = activeNum - limitNum
For num = 1 To insertNum Step 1
Sheets("Traveller Anlysis Report").Select
Rows("8:8").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next num
End If
'3.数据填充
Debug.Print "增行判断完毕,进行数据填充"
'当前正在执行的行数
curNum = startNum
'当前正在执行的差旅人
Dim curTravelerID As Integer
'标记需要数据条的单元格
Dim needColor() As String
Dim colorNum As Integer
'循环填充
curTravelerID = 1
colorNum = 1
ReDim needColor(colorNum To totalTraveller)
For temp = 1 To activeNum Step 1
Sheets("data").Select
travelerID = Range("A" & temp).Value
'3.1差旅人是否和上一次的为同一差旅人
If curTravelerID = travelerID Then
isSameTraveler = True
Else
isSameTraveler = False
End If
curTravelerID = travelerID
'3.2判断是否需要添加数据条标记
If isSameTraveler = False Then
needColor(colorNum) = "F" & (curNum - 1)
colorNum = colorNum + 1
End If
'3.3复制差旅人数据
Sheets("Traveller Anlysis Report").Select
Range("A" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
If Range("A" & curNum) = 0 Then
Range("A" & curNum).Value = ""
End If
Range("B" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
If Range("B" & curNum) = 0 Then
Range("B" & curNum).Value = ""
End If
Range("C" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
If Range("C" & curNum) = 0 Then
Range("C" & curNum).Value = ""
End If
Range("D" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
If Range("D" & curNum) = 0 Then
Range("D" & curNum).Value = ""
End If
Range("E" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
If Range("E" & curNum) = 0 Then
Range("E" & curNum).Value = ""
End If
Range("F" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
'3.4当前行+1,进入下次循环
curNum = curNum + 1
Next temp
'3.5有效数据行的最后一行的最后一列加入needColor
needColor(colorNum) = "F" & (curNum - 1)
'4.设置样式表
'需要设置的单元格
Dim colorBarCells As String
'单元格的总和
Dim colorBarCellsSum As Long
For i = 1 To UBound(needColor)
colorBarCells = colorBarCells + needColor(i) + ","
colorBarCellsSum = colorBarCellsSum + Range(needColor(i)).Value
Next i
colorBarCells = Mid(colorBarCells, 1, Len(colorBarCells) - 1)
Debug.Print "待添加渐变单元格:" & colorBarCells
Debug.Print "待添加渐变单元格的总和:" & colorBarCellsSum
Sheets("Traveller Anlysis Report").Select
Range(colorBarCells).Select
Selection.FormatConditions.AddDatabar
Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
'With Selection.FormatConditions(1)
' .MinPoint.Modify newtype:=xlConditionValueLowestValue
' .MaxPoint.Modify newtype:=xlConditionValueHighestValue
' End With
With Selection.FormatConditions(1).BarColor
.Color = 8700771
.TintAndShade = 0
End With
'5.设置统计栏
Sheets("Traveller Anlysis Report").Select
Range("A" & curNum).Select
If lang = "en_US" Then
Range("A" & curNum) = en_US_TotalReport
Else
Range("A" & curNum) = zh_CN_TotalReport
End If
Selection.Font.Bold = True
Range("F" & curNum).Select
Range("F" & curNum) = colorBarCellsSum
Selection.Font.Bold = True
Range("A" & curNum & ":" & "F" & curNum).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A65000").Select
Application.ScreenUpdating = True
End Sub
特别注意的是注释那段,当关闭excel后会报告excel格式错误问题,但手动操作的没问题,非常怪异,特此标记一下。
VBA代码可以进一步进行优化,不过在那里面写真的是没eclipse方便...
另外经常写到循环或者判断的时候,打进去的代码居然是JAVA代码,悲催啊...
丫的,突然想起来这货不是JAVA啊~~~