Question

我有一个VBA代码（下面），它将最小和最大x轴值设置为指定的单元格（B4和B15）。但是，我的工作簿中有很多图，并且都需要不同的最小和最大x轴范围。我想要一个VBA代码转到绘制的x轴范围，然后找到该范围内的最小值和最大值，并将轴设置为这些值。我怎样才能改变下面的代码呢？

Sub Resize_Fonts()
Dim Sht As Worksheet
Dim Cht As ChartObject

For Each Sht In ActiveWorkbook.Sheets
    For Each Cht In Sht.ChartObjects
        Cht.Chart.ChartArea.Font.Size = 9
        Cht.Chart.ChartArea.Font.Name = "Cambria"
        Cht.Chart.ChartArea.Border.LineStyle = xlNone
        Cht.Chart.Axes(xlValue).MinimumScale = 0
        Cht.Chart.Axes(xlCategory).MinimumScale = Range("B4").Value
        Cht.Chart.Axes(xlCategory).MaximumScale = Range("B15").Value


    Next Cht
Next Sht

End Sub

Answer 1

您可以添加dim count as long并将最小/最大值放在相邻列中。然后在count循环中递增For each并使用Cells([row], [n+] count).value获取单元格值。顺便说一句，您可以使用：

With cht.Chart 
    [...]
End with

Answer 2

尝试使用WorksheetFunction.Min。

    Cht.Chart.Axes(xlCategory).MinimumScale = WorksheetFunction.Min(Columns(2))
    Cht.Chart.Axes(xlCategory).MaximumScale = WorksheetFunction.Max(Columns(2))

这假设x轴值在第2列。

Answer 3

如果最小值和最大值始终在B14:B15 Sht范围内，您可以使用：

Cht.Chart.Axes(xlCategory).MinimumScale = worksheetfunction.Min(Sht.Range("B4:B15"))
Cht.Chart.Axes(xlCategory).MaximumScale = worksheetfunction.Max(Sht.Range("B4:B15"))

Answer 4

尝试使用With Cht.Chart语句，它会缩短并清除您的编码风格。

在B列中查找Min和Max值时，您需要确保通过添加Range完全限定Sht.Range。

<强>代码

Sub Resize_Fonts()

Dim Sht As Worksheet
Dim Cht As ChartObject

For Each Sht In ActiveWorkbook.Sheets
    For Each Cht In Sht.ChartObjects
        With Cht.Chart
            .ChartArea.Font.SIZE = 9
            .ChartArea.Font.Name = "Cambria"
            .cartArea.Border.LineStyle = xlNone
            .Axes(xlValue).MinimumScale = 0
            .Axes(xlCategory).MinimumScale = WorksheetFunction.Min(Sht.Range("B1:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row))
            .Axes(xlCategory).MaximumScale = WorksheetFunction.Max(Sht.Range("B1:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row))
        End With
    Next Cht
Next Sht

End Sub

Answer 5

在阅读您的评论后，正如我第一次用我的其他未注册帐户说的那样，您可以使用此方法：

Sub Resize_Fonts()
Dim Sht As Worksheet
Dim Cht As ChartObject
Dim count as Long 

count = 2 ' For column B
For Each Sht In ActiveWorkbook.Sheets
    For Each Cht In Sht.ChartObjects
        With Cht.Chart
            .ChartArea.Font.Size = 9
            .ChartArea.Font.Name = "Cambria"
            .ChartArea.Border.LineStyle = xlNone
            .Axes(xlValue).MinimumScale = 0
            .Axes(xlCategory).MinimumScale = Sht.Cells(4, count).Value
            .Axes(xlCategory).MaximumScale = Sht.Cells(15, count).Value
        End with
        count = count + n ' with n your "pattern"
    Next Cht
    count = 2 ' reset the count when changing sheet
Next Sht

End Sub

这个假设值总是第4行和第15行。

如果您有任何其他疑问，请评论

Excel VBA代码，用于将x轴设置为绘制范围

5 个答案: