运行宏时,图表不会更新/刷新

时间:2017-10-20 07:46:05

标签: excel vba excel-vba charts

在工作中,我有2013年的优秀成绩,并且我在每次迭代时都会在图表系列中添加新数据。 它完美无缺,每次迭代都可以看到图表更新。

现在我尝试使用excel 2016在我的家用电脑上的代码,无论图表赢得什么更新。我尝试了一切

dim chr as ChartObject
dim chrt as Chart
set chr = Sheet1.ChartObjects.Add
set chrt = chr.Chart

然后我尝试了一切像

doevents
chr.refresh
sheet1.enablecalculation = true
application.screenupdating = true
chr.activate
Application.ontime Now + timeSerial(0,0,1), "wt"

sub wt
    Application.wait + timeSerial(0,0,1)
end sub

你能想到的任何事情......它不会更新 有什么建议吗?谢谢大家

编辑:我发现如果我添加

就行了
Sheet1.ResetAllPageBreaks 

在每次迭代结束时,但是它太慢了代码

Sub risolutore()

   Application.ScreenUpdating = True


    ' DICHIARAZIONE DELLE VARIABILI
    Dim ws As Worksheet
    Dim chr As ChartObject, chr2 As ChartObject
    Dim rng As Range, rng2 As Range
    Dim grafico As Chart, grafico2 As Chart
    '''''''''''''''''''''''''''''''

    ' SHEET SETTING
    Set ws = Foglio5
    ''''''''''''''''

    For Each ch In ws.ChartObjects
        ch.Delete
    Next ch

    'SETTAGGIO DELLE CELLE DI RIFERIMENTO'''''''''''
    w_cells = ws.Range("B2:B9").Address
    v_cell = ws.Range("B16").Address
    s_cell = ws.Range(v_cell).Offset(1, 0).Address
    m_cell = ws.Range(v_cell).Offset(2, 0).Address
    sum_cell = ws.Range(v_cell).Offset(3, 0).Address

    s_col = "F"

    wci = "H"
    wcf = "O"

    nri = 14
    ndati = 40
    nrf = nri + ndati - 1

    m_max = Application.WorksheetFunction.Max(ws.Range(w_cells).Offset(0, 1))

    ws.Range(s_col & nri & ":" & wcf & nrf).ClearContents
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    DoEvents

    ' CICLO RISOLUTORE E GRAFICI
    For i = nri To nrf

        ws.EnableCalculation = False
        ws.EnableCalculation = True
        ' MIN VAR PORTFOLIO
        If i = nri Then
            ' SETTAGGI DEL RISOLUTORE PER IL MIN VAR PORTFOLIO
            obj = ws.Range(s_col & i).Offset(0, 1).Address
           'reset dei parametri del solver
            Application.Run "Solver.xlam!SolverReset"
            'Decido la funzione da ottimizzare
            Application.Run "Solver.xlam!SolverOk", v_cell, 2, 0, w_cells, 1, "GRG Nonlinear"
            ' vincolo di rendimento atteso
            'Application.Run "Solver.xlam!SolverAdd", m_cell, 2, obj
            ' vincolo di peso maggiore di 0
            Application.Run "Solver.xlam!SolverAdd", w_cells, 3, "0"
            ' vincolo di peso minore di 1
            Application.Run "Solver.xlam!SolverAdd", w_cells, 1, "=1"
            ' vincolo di somma pesi uguale a 1
            Application.Run "Solver.xlam!SolverAdd", sum_cell, 2, "=1"

            Application.Run "Solver.xlam!SolverOptions", , , , , , , , , , , , False

            ' avvio il solver
            Application.Run "Solver.xlam!SolverSolve", True

            ws.Range(s_col & i).Value = ws.Range(s_cell).Value
            ws.Range(s_col & i).Offset(0, 1).Value = ws.Range(m_cell).Value
            ws.Range(s_col & i).NumberFormat = "0.000%"
            ws.Range(s_col & i).Offset(0, 1).NumberFormat = "0.000%"
            ws.Range(wci & i & ":" & wcf & i).Value = Application.WorksheetFunction.Transpose(ws.Range(w_cells).Value)
            ws.Range(wci & i & ":" & wcf & i).NumberFormat = "0.00%"

            ' DETERMINO I VALORI DEI RENDIMENTI PER IL GRAFICO
            m_min = ws.Range(m_cell).Value
            max_min = m_max - m_min

            Dim v() As Variant
            ReDim v(1 To ndati)
            v(1) = m_min
            For K = LBound(v) + 1 To UBound(v)
                v(K) = v(K - 1) + max_min / (ndati - 1)
            Next K
            ws.Range(s_col & nri).Offset(0, 1).Resize(UBound(v) - LBound(v) + 1).Value = Application.WorksheetFunction.Transpose(v)
            ws.Range(s_col & nri).Offset(0, 1).Resize(UBound(v) - LBound(v) + 1).NumberFormat = "0.000%"

            ' SETTAGGI DEL PRIMO GRAFICO
            Set rng = ws.Range("Q13:V25")
            Set chr = ws.ChartObjects.Add(Left:=rng.Left, Width:=rng.Width, Top:=rng.Top, Height:=rng.Height)
            Set grafico = chr.Chart
            grafico.ChartType = xlXYScatterSmooth
            grafico.SeriesCollection.NewSeries

            grafico.SeriesCollection(1).XValues = ws.Range(s_col & nri).Offset(0, 0)
            grafico.SeriesCollection(1).Values = ws.Range(s_col & nri).Offset(0, 1)
            grafico.Axes(xlCategory).MinimumScale = ws.Range(s_col & nri).Offset(0, 0) * 0.8
            grafico.Axes(xlCategory).TickLabels.Orientation = 35
            grafico.Axes(xlValue).MinimumScale = m_min * 0.9
            grafico.Axes(xlValue).MaximumScale = m_max * 1.1
            grafico.Legend.Delete

            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

            ' SETTAGGI DEL SECONDO GRAFICO
            Set rng2 = ws.Range("Q26:V42")
            Set chr2 = ws.ChartObjects.Add(Left:=rng2.Left, Width:=rng2.Width, Top:=rng2.Top, Height:=rng2.Height)
            Set grafico2 = chr2.Chart
            grafico2.ChartType = xlAreaStacked100
            grafico2.HasTitle = False
            grafico2.Legend.Position = xlLegendPositionBottom
            grafico2.Axes(xlValue).MinimumScale = 0

            For j = 1 To 8
                grafico2.SeriesCollection.NewSeries
                grafico2.SeriesCollection(j).XValues = ws.Range(s_col & nri & ":" & s_col & nri)
                grafico2.SeriesCollection(j).Values = ws.Range(s_col & nri & ":" & s_col & nri).Offset(0, 2 + j - 1)
                grafico2.SeriesCollection(j).Name = ws.Range(s_col & nri).Offset(-2, 2 + j - 1)
            Next j

            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        ' DETERMINO GLI ALTRI PORTAFOGLI EFFICIENTI
        ElseIf i > nri Then

            If i = nri + 1 Then
                grafico.ChartType = xlXYScatterSmoothNoMarkers
            End If

            obj = ws.Range(s_col & i).Offset(0, 1).Address
           'reset dei parametri del solver
            Application.Run "Solver.xlam!SolverReset"
            'Decido la funzione da ottimizzare
            Application.Run "Solver.xlam!SolverOk", v_cell, 2, 0, w_cells, 1, "GRG Nonlinear"
            ' vincolo di rendimento atteso
            Application.Run "Solver.xlam!SolverAdd", m_cell, 2, obj
            ' vincolo di peso maggiore di 0
            Application.Run "Solver.xlam!SolverAdd", w_cells, 3, "0"
            ' vincolo di peso minore di 1
            Application.Run "Solver.xlam!SolverAdd", w_cells, 1, "=1"
              ' vincolo di somma pesi uguale a 1
            Application.Run "Solver.xlam!SolverAdd", sum_cell, 2, "=1"

            Application.Run "Solver.xlam!SolverOptions", , , , , , , , , , , , False

            ' avvio il solver
            Application.Run "Solver.xlam!SolverSolve", True

            ws.Range(s_col & i).Value = ws.Range(s_cell).Value
            ws.Range(s_col & i).NumberFormat = "0.000%"
            ws.Range(wci & i & ":" & wcf & i).Value = Application.WorksheetFunction.Transpose(ws.Range(w_cells).Value)
            ws.Range(wci & i & ":" & wcf & i).NumberFormat = "0.00%"


            grafico.SeriesCollection(1).XValues = ws.Range(s_col & nri & ":" & s_col & i)
            grafico.SeriesCollection(1).Values = ws.Range(s_col & nri & ":" & s_col & i).Offset(0, 1)


            For j = 1 To 8
                grafico2.SeriesCollection(j).XValues = ws.Range(s_col & nri & ":" & s_col & nrf)
                grafico2.SeriesCollection(j).Values = ws.Range(s_col & nri & ":" & s_col & i).Offset(0, 2 + j - 1)
            Next j           
        End If
    Next i


    Application.ScreenUpdating = True
    MsgBox "Ottimizazione Completata", vbInformation
End Sub

1 个答案:

答案 0 :(得分:1)

您是否尝试过更改图表数据?

我使用图表,当我更改数据时,图表立即更改。