¹Ïªí±±¨îªº°ÝÃD,¤Îª©¥»°ÝÃD

fei6999

§Ú·Q½Ð±Ðªº¬O±±¨î¹ÏªíµJÂI,³o³¡¥÷­¯¥Íªº«Ü!¥ýÁ°Õ!°ÝÃD¦p¤U:¬O§_¦³¨ä¥Lªº¤èªk«Øij!
ch1.rar (933.43 KB)

¤U¸ü¦¸¼Æ: 10

2014-11-23 08:31

  ActiveWindow.Visible = False '*³o¤@¦æ¦³°ÝÃD:¦bexcel2002ªº¹q¸£¤W­n³o¤@¦æ¤~¯à"Â÷¶}"¿ï¨úªºChartObjects(1)µJÂI,­Y¤Ö³o¤@¦æ·|¦bListIndex = ActiveChart.DropDowns(1).Value + 3
µLªk§ä¨ìª«¥ó'¦ý¬O¦boffice 2013¤W³o¦æ·|³y¦¨ActiveChart¤èªk('_Global'ª«¥ó)¥¢±Ñ
µ{¦¡½X¦p¤U:

Public s_time As Boolean
Public ListIndex As Integer



Sub ViewChart()

    Dim StartRow, m_number As Long
   
     gk = Sheets("®w¦s¾ã²z").Range("b3600").End(xlUp).Row  'µ§¼Æ'
     If Sheets("®w¦s¾ã²z").CommandButton1.Caption = "®i¶}À禬" Then
      
        Sheets("®w¦s¾ã²z").CommandButton1.Caption = "Ãö³¬À禬"
        Sheets("®w¦s¾ã²z").CommandButton1.BackColor = vbBlue
        m_number = ActiveCell.Row
        Columns("AQ:BD").Select
        Selection.EntireColumn.Hidden = False
        Columns("AQ:AQ").Select
        Selection.EntireColumn.Hidden = True
         'Call read
     Else

     m_number = ActiveCell.Row
     End If
     
    If m_number > 5 And m_number <= gk Then
        StartRow = m_number
    Else
        StartRow = 5
    End If

    With Sheets("Chart1")
        .Activate
        .Deselect
         
    End With

    Charts(1).DropDowns(1).Value = StartRow - 4
    Call UpdateChart(StartRow - 1)
End Sub

Sub DropDown1_Change()
'On Error Resume Next
    Dim ListIndex As Integer
    Application.ScreenUpdating = False
    gk = Sheets("®w¦s¾ã²z").Range("b3600").End(xlUp).Row  'µ§¼Æ'
    If Sheets("®w¦s¾ã²z").CommandButton1.Caption = "®i¶}À禬" Then
      
      Sheets("®w¦s¾ã²z").CommandButton1.Caption = "Ãö³¬À禬"
      Sheets("®w¦s¾ã²z").CommandButton1.BackColor = vbBlue
      Sheets("®w¦s¾ã²z").Select
      Sheets("®w¦s¾ã²z").Columns("AQ:BD").Select
      Selection.EntireColumn.Hidden = False
      Sheets("®w¦s¾ã²z").Columns("AQ:AQ").Select
      Selection.EntireColumn.Hidden = True
      Call read
    End If
   
    Sheets("chart1").Select

    ListIndex = ActiveChart.DropDowns(1).Value + 3
    If ListIndex > gk - 1 Then Exit Sub
    Call UpdateChart(ListIndex)
End Sub

Sub UpdateChart(Item)

    Dim TheChart As Chart
    Dim DataSheet As Worksheet
    Dim CatTitles As Range, SrcRange As Range
    Dim SourceData As Range
    Dim s_string As String
    Set TheChart = Sheets("Chart1")
    Set DataSheet = Sheets("®w¦s¾ã²z")
   

    With DataSheet
        Set CatTitles = .Range("Ar4:bc4")
        Set SrcRange = .Range(.Cells(Item + 1, 44), _
          .Cells(Item + 1, 55))
    End With
    Set SourceData = Union(CatTitles, SrcRange)

   
    '©u¦¨ªø
    Dim q, q1, q2, q3, q4 As Long
    Dim m_add, q_add As String
    Dim m_month As Byte
      If Sheets("®w¦s¾ã²z").Cells(Item + 1, 3) = "" Then
         Exit Sub
      Else
         m_month = Sheets("®w¦s¾ã²z").Cells(Item + 1, 56).End(xlToLeft).Column - 43
      End If
      
       q1 = Sheets("®w¦s¾ã²z").Cells(Item + 1, 44) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 45) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 46)
       q2 = Sheets("®w¦s¾ã²z").Cells(Item + 1, 47) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 48) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 49)
       q3 = Sheets("®w¦s¾ã²z").Cells(Item + 1, 50) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 51) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 52)
       q4 = Sheets("®w¦s¾ã²z").Cells(Item + 1, 53) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 54) + Sheets("®w¦s¾ã²z").Cells(Item + 1, 55)
       If m_month >= 6 And m_month <= 8 Then If q1 > 0 And q2 > 0 Then q = Round((q2 - q1) / q1 * 100, 2) Else
       If m_month >= 9 And m_month <= 11 Then If q2 > 0 And q3 > 0 Then q = Round((q3 - q2) / q2 * 100, 2) Else
       If m_month = 12 Then If q3 > 0 And q4 > 0 Then q = Round((q4 - q3) / q3 * 100, 2) Else

       If Sheets("®w¦s¾ã²z").Cells(Item + 1, 42) > 0 Then m_add = "¦¨ªø ": ActiveChart.ChartTitle.Font.ColorIndex = 3 Else m_add = "°I°h": ActiveChart.ChartTitle.Font.ColorIndex = 5
       If q > 0 Then q_add = "¦¨ªø " Else q_add = "°I°h"
       s_string = Sheets("®w¦s¾ã²z").Cells(Item + 1, 2) & Sheets("®w¦s¾ã²z").Cells(Item + 1, 3) _
           & " ³æ©uEPS " & Sheets("®w¦s¾ã²z").Cells(Item + 1, 33) & "  ²Ö­pEPS " _
           & Sheets("®w¦s¾ã²z").Cells(Item + 1, 32) & "  " & m_month & "¤ëÀ禬" _
           & m_add & Sheets("®w¦s¾ã²z").Cells(Item + 1, 42) * 100 & "%" & " ©u" & q_add & q & "%" & " ¤ò§Q²v" & Sheets("®w¦s¾ã²z").Cells(Item + 1, 38) & "¸û¤W©u" & Sheets("®w¦s¾ã²z").Cells(Item + 1, 41) & "%"

    With TheChart
        
        .SetSourceData Source:=SourceData, PlotBy:=xlRows
        .ChartTitle.Left = TheChart.ChartArea.Left
        .ChartTitle.Text = s_string
        '.Deselect

    End With
   
    ActiveChart.ChartTitle.Font.FontStyle = "²ÊÅé"
     ActiveChart.ChartTitle.Font.Size = 17
    ActiveChart.SeriesCollection(1).DataLabels.Font.Size = 10
     ActiveChart.SeriesCollection(1).DataLabels.Font.ColorIndex = 5
Ex '§ï¹Ïªí¦WºÙÁקK¦WºÙ¨C¦¸ÅÜ°Ê
¹Ï2 (Item)
End Sub
Sub ¹Ï2(Item1)
    'Dim TheChart As Chart
    Dim DataSheet As Worksheet
    Dim CatTitles As Range, SrcRange As Range
    Dim SourceData As Range
    Dim s1_string As String
'¹Ï2

    Set DataSheet = Sheets("®w¦s¾ã²z")

    With DataSheet
        Set CatTitles = .Range("BF4:BI4")
        Set SrcRange = .Range(.Cells(Item1 + 1, 58), _
          .Cells(Item1 + 1, 61))
    End With
        Set SourceData = Union(CatTitles, SrcRange)
    s1_string = Sheets("®w¦s¾ã²z").Cells(Item1 + 1, 3) & " ¤ò§Q²v¨«¶Õ"
   MsgBox ActiveWindow.Caption
     ActiveSheet.ChartObjects(1).Activate
   

    ActiveChart.SetSourceData Source:=SourceData, PlotBy:=xlRows
    ActiveChart.ChartTitle.Text = s1_string
    ActiveChart.Deselect
    ActiveWindow.Visible = False '*³o¤@¦æ¦³°ÝÃD:¦bexcel2002ªº¹q¸£¤W­n³o¤@¦æ¤~¯à"Â÷¶}"¿ï¨úªºChartObjects(1)µJÂI,­Y¤Ö³o¤@¦æ·|¦bListIndex = ActiveChart.DropDowns(1).Value + 3µLªk§ä¨ìª«¥ó
'¦ý¬O¦boffice 2013¤W³o¦æ·|³y¦¨ActiveChart¤èªk('_Global'ª«¥ó)¥¢±Ñ

ActiveChart.ChartArea.Select
      
End Sub
Sub Ex()
    Dim I As Variant

    With ActiveSheet
        For I = 1 To .ChartObjects.Count
            'MsgBox .ChartObjects(I).Name
            
            .ChartObjects(I).Name = .ChartObjects(I).Name ' & " ­×§ï«á"
        Next
        '************
        For Each I In .ChartObjects
           ' MsgBox I.Name
        Next

    End With
End Sub

fei6999

§Ú°®¯Ü¥Î«OÅ@¤u§@ªíªº¤è¦¡§â­¶­±«OÅ@¦í
°õ¦æ®É¦A
ActiveSheet.Unprotect
¥H§K¾Þ§@»~IJ¹Ïªí¾É­P¥¢µJ
¦Ü©óActiveWindow.Visible = False³o¦æ
«h¦p¤U³B²z³o¼Ë¤]¥i¥H¹B§@¦b2013ªºª©¥»
   p_name = ActiveWorkbook.Name
    ActiveWindow.Visible = False
    Windows(p_name).Activate
¾ãÅé¹B§@¼È®É¥i¦æ,¦ý¬OÁÙ¬O§Æ±æ¦³¨ä¥L¤è¦¡¥i°Ñ¦Ò!