Excel图表缩小功能

时间:2013-04-30 12:59:41

标签: excel excel-vba charts excel-2003 vba

我已在Excel中为图表编写了放大功能,但我不知道如何使用滚动条值进行缩小。

有人能帮助我吗?

Private Sub Zoom_X_Change1()
    With ActiveSheet.ChartObjects("Chart 20").Chart

        If (.Axes(xlCategory).MinimumScale >= 0) And (.Axes(xlCategory).MinimumScale < 0.4) Then
                .Axes(xlCategory).MinimumScale = .Axes(xlCategory).MinimumScale + 0.1
        End If

        If (.Axes(xlCategory).MaximumScale > 0.6) And (.Axes(xlCategory).MaximumScale <= 1) Then
                .Axes(xlCategory).MaximumScale = .Axes(xlCategory).MaximumScale - 0.1
        End If

    End With
End Sub

滚动:

Dim aX As Integer
Dim aY As Integer
Dim arrScale As Variant

Private Sub Scale_X_Change()
    arrScale = Array(-0.5, 1, 2, 3, 4, 5, 6, 7, 8, 10, 11)
    aX = arrScale(Scale_X.Value - 1)
    With ActiveSheet.ChartObjects("Chart 20").Chart
        .Axes(xlCategory).MinimumScale = 0
        .Axes(xlCategory).MaximumScale = aX
    End With
End Sub

1 个答案:

答案 0 :(得分:0)

试试这个。确保ScrollBar链接到一个单元格,在我的示例中它是J5但是根据需要进行修改。

此宏会将当前轴.MinimumScale与链接单元格的值进行比较,并放大和缩小。

Format control to a linked cell

还要确保相应地设置ScrollBar的最小值/最大值和增量值,例如:

Set the scroll bar properties

Sub ScrollBar1_Change()
Dim ax As Axis
Dim sbMin As Double
Dim sbMax As Double
Dim sbMove As Double
Dim sbVal As Double
Dim minVal As Double
Dim maxVal As Double

sbMin = 0   '## Set this to the minimum desired axis scale.'
sbMax = 0.6 '## set this to the maximum desired axis scale.'
sbMove = 0.1 '## Set this to the desired increment.'
sbVal = Range("J5").Value '## this is the cell linked to the scrollbar, modify as needed.'

Set ax = ActiveSheet.ChartObjects("Chart 20").Chart.Axes(xlCategory)

    With ax
        '## check to see if we are zooming out, and flip the sign on sbMove'
        If sbVal < .MinimumScale Then sbMove = sbMove * -1
        '## Manipulate the axis min & max:'
        If Not sbVal >= 0.5 * sbMax Then
        '## Manipulate the axis min & max:'
            If (.MinimumScale <> sbVal) Then
                .MinimumScale = .MinimumScale + sbMove
                .MaximumScale = .MaximumScale - sbMove
                .CrossesAt = sbVal
            End If
        End If
    End With

End Sub