圖表控制的問題,及版本問題

fei6999

我想請教的是控制圖表焦點,這部份陌生的很!先謝啦!問題如下:是否有其他的方法建議!
ch1.rar (933.43 KB)

下載次數: 10

2014-11-23 08:31

  ActiveWindow.Visible = False '*這一行有問題:在excel2002的電腦上要這一行才能"離開"選取的ChartObjects(1)焦點,若少這一行會在ListIndex = ActiveChart.DropDowns(1).Value + 3
無法找到物件'但是在office 2013上這行會造成ActiveChart方法('_Global'物件)失敗
程式碼如下:

Public s_time As Boolean
Public ListIndex As Integer



Sub ViewChart()

    Dim StartRow, m_number As Long
   
     gk = Sheets("庫存整理").Range("b3600").End(xlUp).Row  '筆數'
     If Sheets("庫存整理").CommandButton1.Caption = "展開營收" Then
      
        Sheets("庫存整理").CommandButton1.Caption = "關閉營收"
        Sheets("庫存整理").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("庫存整理").Range("b3600").End(xlUp).Row  '筆數'
    If Sheets("庫存整理").CommandButton1.Caption = "展開營收" Then
      
      Sheets("庫存整理").CommandButton1.Caption = "關閉營收"
      Sheets("庫存整理").CommandButton1.BackColor = vbBlue
      Sheets("庫存整理").Select
      Sheets("庫存整理").Columns("AQ:BD").Select
      Selection.EntireColumn.Hidden = False
      Sheets("庫存整理").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("庫存整理")
   

    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)

   
    '季成長
    Dim q, q1, q2, q3, q4 As Long
    Dim m_add, q_add As String
    Dim m_month As Byte
      If Sheets("庫存整理").Cells(Item + 1, 3) = "" Then
         Exit Sub
      Else
         m_month = Sheets("庫存整理").Cells(Item + 1, 56).End(xlToLeft).Column - 43
      End If
      
       q1 = Sheets("庫存整理").Cells(Item + 1, 44) + Sheets("庫存整理").Cells(Item + 1, 45) + Sheets("庫存整理").Cells(Item + 1, 46)
       q2 = Sheets("庫存整理").Cells(Item + 1, 47) + Sheets("庫存整理").Cells(Item + 1, 48) + Sheets("庫存整理").Cells(Item + 1, 49)
       q3 = Sheets("庫存整理").Cells(Item + 1, 50) + Sheets("庫存整理").Cells(Item + 1, 51) + Sheets("庫存整理").Cells(Item + 1, 52)
       q4 = Sheets("庫存整理").Cells(Item + 1, 53) + Sheets("庫存整理").Cells(Item + 1, 54) + Sheets("庫存整理").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("庫存整理").Cells(Item + 1, 42) > 0 Then m_add = "成長 ": ActiveChart.ChartTitle.Font.ColorIndex = 3 Else m_add = "衰退": ActiveChart.ChartTitle.Font.ColorIndex = 5
       If q > 0 Then q_add = "成長 " Else q_add = "衰退"
       s_string = Sheets("庫存整理").Cells(Item + 1, 2) & Sheets("庫存整理").Cells(Item + 1, 3) _
           & " 單季EPS " & Sheets("庫存整理").Cells(Item + 1, 33) & "  累計EPS " _
           & Sheets("庫存整理").Cells(Item + 1, 32) & "  " & m_month & "月營收" _
           & m_add & Sheets("庫存整理").Cells(Item + 1, 42) * 100 & "%" & " 季" & q_add & q & "%" & " 毛利率" & Sheets("庫存整理").Cells(Item + 1, 38) & "較上季" & Sheets("庫存整理").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 '改圖表名稱避免名稱每次變動
圖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("庫存整理")

    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("庫存整理").Cells(Item1 + 1, 3) & " 毛利率走勢"
   MsgBox ActiveWindow.Caption
     ActiveSheet.ChartObjects(1).Activate
   

    ActiveChart.SetSourceData Source:=SourceData, PlotBy:=xlRows
    ActiveChart.ChartTitle.Text = s1_string
    ActiveChart.Deselect
    ActiveWindow.Visible = False '*這一行有問題:在excel2002的電腦上要這一行才能"離開"選取的ChartObjects(1)焦點,若少這一行會在ListIndex = ActiveChart.DropDowns(1).Value + 3無法找到物件
'但是在office 2013上這行會造成ActiveChart方法('_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

我乾脆用保護工作表的方式把頁面保護住
執行時再
ActiveSheet.Unprotect
以免操作誤觸圖表導致失焦
至於ActiveWindow.Visible = False這行
則如下處理這樣也可以運作在2013的版本
   p_name = ActiveWorkbook.Name
    ActiveWindow.Visible = False
    Windows(p_name).Activate
整體運作暫時可行,但是還是希望有其他方式可參考!