簡體   English   中英

如何修改此 VBA 代碼以運行 Powerpoint 演示文稿而不是工作表?

[英]How do I modify this VBA code to run through a Powerpoint presentation instead of a worksheet?

VBA 初學者在這里。 我有這個問題,我必須:循環瀏覽給定演示文稿中的每個圖表,然后調整其 Y 軸 我想自動化這個過程,因為手動瀏覽每個圖表並調整它的軸是乏味的。

因為我是一個菜鳥,所以我不得不從互聯網上復制代碼並根據我的需要進行調整。 我做了一些小的調整,但無法弄清楚一些事情。

  1. 甚至可以自動化這個過程嗎?
  2. 該代碼是為 Excel 編寫的,無法在 powerpoint 上運行,我要進行哪些更改才能使其無錯誤運行?
  3. 我需要對代碼進行任何其他調整嗎?
  4. 每當我在 Excel 上運行此代碼時,它都不會遍歷活動工作表中的所有圖表。 我有 17 個標題相似的圖表。 一些圖表進行了調整,而另一些則保持原樣。 為什么會這樣?
    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 沒有MinMax功能,我也構建了它們:

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.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM