wse320 发表于 2011-9-18 16:29:39

哪位大大帮看一下这个宏是什么意思?

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区域内。

wse320 发表于 2011-9-18 16:37:31

恩,附上原件
页: [1]
查看完整版本: 哪位大大帮看一下这个宏是什么意思?