哪位大大帮看一下这个宏是什么意思？
Excel里的，我搞了半天愣是搞不对，他到底是什么要求啊Function ExistSheet(ByVal name As String) As Boolean
Dim flag As Boolean
flag = True
On Error GoTo 10
Sheets(name).Select
ExistSheet = flag
Exit Function
10
flag = False
Resume Next
End Function
Function ExistChart(ByVal name As String) As Boolean
Dim flag As Boolean
flag = True
On Error GoTo 10
Charts(name).Select
ExistChart = flag
Exit Function
10
flag = False
Resume Next
End Function
Function CheckCellFormat(ByVal SheetName, CellName, CheckFormat As String) As Boolean
Sheets(SheetName).Select
Range(CellName).Select
If Selection.NumberFormatLocal <> CheckFormat Then
CheckCellFormat = False
Else
CheckCellFormat = True
End If
End Function
Sub SetCellValue(ByVal SheetName, CellName, CellValue As String)
Sheets(SheetName).Select
Range(CellName).Select
ActiveCell.FormulaR1C1 = CellValue
End Sub
Function GetCellValue(ByVal SheetName, ByVal CellName As String) As String
Dim oldvalue As String
Sheets(SheetName).Select
Range(CellName).Select
oldvalue = Selection.NumberFormatLocal
Selection.NumberFormatLocal = "@"
GetCellValue = ActiveCell.FormulaR1C1
Selection.NumberFormatLocal = oldvalue
End Function
Function ColCheckFormula(ByVal SheetName, Startcol As String, ByVal rowi, rowj As Long, ByVal Formula As String) As Boolean
Dim i As Long
If Not ExistSheet(SheetName) Then
MsgBox " 不存在工作表“" & SheetName, vbOKOnly
End If
' coli<=colj
ColCheckFormula = True
For i = rowi To rowj
If (GetCellValue(SheetName, Startcol & i) <> Formula) Then
ColCheckFormula = False
End If
Next i
End Function
Function RowCheckFormula(ByVal SheetName, Startrow As String, ByVal coli, colj As String, ByVal Formula As String) As Boolean
Dim i As Long
If Not ExistSheet(SheetName) Then
MsgBox " 不存在工作表“" & SheetName, vbOKOnly
End If
' coli<=colj
RowCheckFormula = True
For i = Asc(coli) To Asc(colj)
If (GetCellValue(SheetName, Chr(i) & Startrow) <> Formula) Then
RowCheckFormula = False
End If
Next i
End Function
Sub FA()
Dim ok As Boolean
ok = True
If Not RowCheckFormula("F", 16, "D", "H", "=R[-3]C-R[-2]C-R[-1]C") Then ok = False
If ok Then
SetCellValue "F", "A2", "对"
Else
SetCellValue "F", "A2", "错"
End If
End Sub
Sub FB()
Dim ok As Boolean
ok = True
If GetCellValue("F", "D17") <> "0" Then ok = False
If Not RowCheckFormula("F", 17, "E", "H", "=(R[-1]C-R[-1]C[-1])/R[-1]C[-1]") Then ok = False
If ok Then
SetCellValue "F", "A3", "对"
Else
SetCellValue "F", "A3", "错"
End If
End Sub
Sub FC()
Dim ok As Boolean
ok = True
For i = Asc("D") To Asc("H")
If Not CheckCellFormat("F", Chr(i) & 17, "0.00%") Then
ok = False
Exit For
End If
Next i
If ok Then
SetCellValue "F", "A4", "对"
Else
SetCellValue "F", "A4", "错"
End If
End Sub
Sub FD()
Dim ok As Boolean
ok = True
Sheets("F").Select
Range("B12").Select
If Selection.Font.ColorIndex <> 2 Then ok = False
If Selection.Font.Color <> 16777215 Then ok = False
Range("F15").Select
If Selection.Font.ColorIndex <> 11 Then ok = False
If Selection.Font.Color <> 8388608 Then ok = False
If ok Then
SetCellValue "F", "A5", "对"
Else
SetCellValue "F", "A5", "错"
End If
End Sub
Sub FE()
Dim ok As Boolean
ok = True
If Not ExistChart("Chart1") Then ok = False
If ok Then
Charts("Chart1").Select
If ok And Not (ActiveChart.ChartType = xlColumnClustered) Then ok = False
If ok And ActiveChart.SeriesCollection.Count <> 4 Then ok = False
If ok Then
For i = 1 To 4
x = ActiveChart.SeriesCollection(i).Formula
If i = 1 And x <> "=SERIES(F!$B$13,F!$C$12:$H$12,F!$C$13:$H$13,1)" Then
ok = False
Exit For
End If
If i = 2 And x <> "=SERIES(F!$B$14,F!$C$12:$H$12,F!$C$14:$H$14,2)" Then
ok = False
Exit For
End If
If i = 3 And x <> "=SERIES(F!$B$15,F!$C$12:$H$12,F!$C$15:$H$15,3)" Then
ok = False
Exit For
End If
If i = 4 And x <> "=SERIES(F!$B$16,F!$C$12:$H$12,F!$C$16:$H$16,4)" Then
ok = False
Exit For
End If
Next i
End If
With ActiveChart
If ok And .HasTitle <> True Then ok = False
If ok And .ChartTitle.Characters.Text <> "公司情况表" Then ok = False
If ok And .Axes(xlCategory, xlPrimary).HasTitle <> True Then ok = False
If ok And .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text <> "年份" Then ok = False
If ok And .Axes(xlValue, xlPrimary).HasTitle <> True Then ok = False
If ok And .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text <> "金额（万）" Then ok = False
If ok And ActiveChart.HasLegend <> True Then ok = False
ActiveChart.Legend.Select
If ok And Selection.Position <> xlRight Then ok = False
End With
End If
If ok Then
SetCellValue "F", "A6", "对"
Else
SetCellValue "F", "A6", "错"
End If
End Sub
Sub FF()
Dim ok As Boolean
ok = True
If Not ExistChart("Chart1") Then ok = False
If ok Then
Charts("Chart1").Select
If ok Then
ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True
x = Selection.Font.ColorIndex
With Selection.Font
If ok And .name <> "黑体" Then ok = False
If ok And .Size <> 22 Then ok = False
If ok And Selection.Font.Bold <> True Then ok = False
If ok And .ColorIndex <> 5 Then ok = False
End With
End If
If ActiveChart.Axes.Count <> 2 Then ok = False
If ok Then
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
If ok And .MaximumScale <> 1600 Then ok = False
If ok And .MajorUnit <> 100 Then ok = False
End With
End If
End If
If ok Then
SetCellValue "F", "A8", "对"
Else
SetCellValue "F", "A8", "错"
End If
End Sub
Sub FG()
Dim ok As Boolean
ok = True
If ActiveSheet.ChartObjects.Count <> 1 Then ok = False
If ok Then
Dim x As ChartObject
Set x = ActiveSheet.ChartObjects(1)
x.Activate
If (ActiveSheet.Shapes(x.name).BottomRightCell.Column <> 16) Or (ActiveSheet.Shapes(x.name).BottomRightCell.Row <> 24) Then ok = flase
If (ActiveSheet.Shapes(x.name).TopLeftCell.Column <> 10) Or (ActiveSheet.Shapes(x.name).TopLeftCell.Row <> 12) Then ok = flase
If ActiveChart.ChartType <> xlLineMarkers Then ok = False
If ok Then
With ActiveChart
If (Not .HasTitle = True Or Not .ChartTitle.Characters.Text = "利润年增长率") Then ok = False
End With
End If
If ActiveChart.Axes.Count = 2 Then
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
If ok And .MaximumScale <> 0.6 Then ok = False
If ok And .MajorUnit <> 0.05 Then ok = False
End With
End If
If ok And ActiveChart.SeriesCollection.Count <> 1 Then ok = False
If ok Then
For i = 1 To 1
y = ActiveChart.SeriesCollection(i).Formula
If i = 1 And y <> "=SERIES(F!$B$17,F!$C$12:$H$12,F!$C$17:$H$17,1)" Then
ok = False
Exit For
End If
If i = 2 And y <> "=SERIES(F!$B$14,F!$C$12:$H$12,F!$C$14:$H$14,2)" Then
ok = False
Exit For
End If
If i = 3 And y <> "=SERIES(F!$B$15,F!$C$12:$H$12,F!$C$15:$H$15,3)" Then
ok = False
Exit For
End If
If i = 4 And y <> "=SERIES(F!$B$16,F!$C$12:$H$12,F!$C$16:$H$16,4)" Then
ok = False
Exit For
End If
Next i
End If
End If
If ok Then
SetCellValue "F", "A9", "对"
Else
SetCellValue "F", "A9", "错"
End If
End Sub
Excel里的要求是以B12：H12，B17：H17为数据源生成图表：数据点折线图，最大刻度为0.6，主要刻度为0.05图表放在当前工作表的J12:P24区域内。 恩，附上原件
页:
[1]