[英]How do I modify this VBA code to run through a Powerpoint presentation instead of a worksheet?
VBA 初學者在這里。 我有這個問題,我必須:循環瀏覽給定演示文稿中的每個圖表,然后調整其 Y 軸。 我想自動化這個過程,因為手動瀏覽每個圖表並調整它的軸是乏味的。
因為我是一個菜鳥,所以我不得不從互聯網上復制代碼並根據我的需要進行調整。 我做了一些小的調整,但無法弄清楚一些事情。
Sub Chartaxes()
Dim cht As ChartObject
Dim srs As Series
Dim FirstTime As Boolean
Dim MaxNumber As Double
Dim MinNumber As Double
Dim MaxChartNumber As Double
Dim MinChartNumber As Double
Dim Padding As Double
'Input Padding on Top of Min/Max Numbers (Percentage)
Padding = 0.1 'Number between 0-1
'Optimize Code
Application.ScreenUpdating = False
'Loop Through Each Chart On ActiveSheet
For Each cht In ActiveSheet.ChartObjects
'First Time Looking at This Chart?
FirstTime = True
'Determine Chart's Overall Max/Min From Connected Data Source
For Each srs In cht.Chart.SeriesCollection
'Determine Maximum value in Series
MaxNumber = Application.WorksheetFunction.Max(srs.Values)
'Store value if currently the overall Maximum Value
If FirstTime = True Then
MaxChartNumber = MaxNumber
ElseIf MaxNumber > MaxChartNumber Then
MaxChartNumber = MaxNumber
End If
'Determine Minimum value in Series (exclude zeroes)
MinNumber = Application.WorksheetFunction.Min(srs.Values)
'First Time Looking at This Chart?
FirstTime = False
Next srs
'Rescale Y-Axis
cht.Chart.Axes(xlValue).MinimumScale = 0
cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
Next cht
'Optimize Code
Application.ScreenUpdating = True
End Sub
如果問題很愚蠢,我很抱歉,如果我不應該在這里發布,請在評論中告訴我。 另外,讓我知道是否有更好的方法可以做到這一點。
先感謝您!
請嘗試下一個適應版本,能夠在Outlook
中工作。 VBA Outlook 沒有Min
, Max
功能,我也構建了它們:
Sub ModffCharts()
Dim sh As Shape, ch As Chart, srs, Padding As Double, FirstTime As Boolean
Dim MaxChartNumber As Double, MaxNumber As Double, MinNumber As Double
Padding = 0.1
FirstTime = True
For Each sh In Application.ActiveWindow.View.Slide.Shapes 'shapes of the active slide...
If sh.HasChart = msoTrue Then
Set ch = sh.Chart
Debug.Print ch.SeriesCollection.Count
For Each srs In ch.SeriesCollection
'Determine Maximum value in Series
MaxNumber = MaX(srs.Values)
'Store value if currently the overall Maximum Value
If FirstTime = True Then
MaxChartNumber = MaxNumber
ElseIf MaxNumber > MaxChartNumber Then
MaxChartNumber = MaxNumber
End If
'Determine Minimum value in Series
MinNumber = MiN(srs.Values)
'First Time Looking at This Chart?
FirstTime = False
Next srs
ch.Axes(xlValue).MinimumScale = 0
ch.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
End If
Next sh
End Sub
Function MaX(arr) As Double
Dim i As Long, Mx As Double
For i = LBound(arr) To UBound(arr)
If arr(i) > Mx Then Mx = arr(i)
Next i
MaX = Mx
End Function
Function MiN(arr) As Double
Dim i As Long, Mn As Double
Mn = MaX(arr)
For i = LBound(arr) To UBound(arr)
If arr(i) < Mn Then Mn = arr(i)
Next i
MiN = Mn
End Function
請測試它並發送一些反饋。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.