Hỗ trợ sửa, nâng cấp code VBA

[eagle12]

Gửi các bác,

Em có tìm được 1 macro hỗ trợ căn chỉnh lại tất cả các chart biểu đồ hiện thị trong worksheet
Tuy nhiên không phải tất cả các đồ thị em đều muốn macro tự động căn chỉnh,

Nhờ các bác giúp chỉnh sửa code thêm hàm để có thể loại trừ ra những chart mà em không muốn căn chỉnh ( vd "chart 1", "chart 3" )...

Cám ơn các bác nhiều

Bạn cần đăng nhập để thấy hình ảnh

Sub Get_chartAxis_updateALL()
'PURPOSE: Adjust Y-Axis according to Min/Max of Chart Data
'SOURCE: www.TheSpreadsheetGuru.com

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)
         
        'Store value if currently the overall Minimum Value
          If FirstTime = True Then
            MinChartNumber = MinNumber
          ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then
            MinChartNumber = MinNumber
          End If
       
        'First Time Looking at This Chart?
          FirstTime = False
      Next srs
     
    'Rescale Y-Axis
      cht.Chart.Axes(xlValue).MinimumScale = MinChartNumber * (1 - Padding)
      cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)
 
  Next cht

'Optimize Code
  Application.ScreenUpdating = True

End Sub

 

[tuhocvba]

  For Each cht In ActiveSheet.ChartObjects
    If cht.Name <> "Chart 3" And cht.Name <> "Chart 4" Then
    
    End if

 

[eagle12]

Cám ơn bạn rất nhiều Admin

  For Each cht In ActiveSheet.ChartObjects
    If cht.Name <> "Chart 3" And cht.Name <> "Chart 4" Then
   
    End if