复制绘图区域在 Powerpoint VBA 中无法正常工作

我拼凑了以下代码，将图表的格式从一个图表复制到另一个图表。代码仍然很混乱，因为我试图想出引用图表的最佳方法（欢迎任何想法！）。

我无法准确复制主要是绘图区域和辅助访问的格式和位置。

一个页面上必须有两个图表，首先选择源，然后选择目标。目前来看，它们应该是同一类型。

感谢您的帮助。

Sub CopyChartFormat()

' Define the source and destination charts
Dim sourceChart As Chart
Dim destChart As Chart

'Check if two charts are selected
If ActiveWindow.Selection.Type <> ppSelectionShapes Then
    MsgBox "Please select two charts."
    Exit Sub
End If

If ActiveWindow.Selection.ShapeRange.Count <> 2 Then
    MsgBox "Please select two charts."
    Exit Sub
End If

Set sourceChart = ActiveWindow.Selection.ShapeRange(1).Chart
Set destChart = ActiveWindow.Selection.ShapeRange(2).Chart
    
''    If .HasChart = True Then
''    End If

    '' Chart size
    ActiveWindow.Selection.ShapeRange(2).Width = ActiveWindow.Selection.ShapeRange(1).Width
    ActiveWindow.Selection.ShapeRange(2).Height = ActiveWindow.Selection.ShapeRange(1).Height
    
'' Adjust plot area size and fill

    With destChart.PlotArea
        .Top = sourceChart.PlotArea.Top
        .Left = sourceChart.PlotArea.Left
        .Height = sourceChart.PlotArea.Height
        .Width = sourceChart.PlotArea.Width
    
''        .Format.Fill.ForeColor.RGB = sourceChart.PlotArea.Format.Fill.ForeColor.RGB
''        .Format.Line.ForeColor.RGB = sourceChart.PlotArea.Format.Line.ForeColor.RGB
    
    
    End With


End Sub

你错过了情节区域的内部。我添加了尽可能多的东西。我测试过，如果字体大小不同，我必须运行两次才能得到想要的结果。

Sub CopyChartFormat()

' Define the source and destination charts
Dim sourceChart As Chart
Dim destChart As Chart

'Check if two charts are selected
If ActiveWindow.Selection.Type <> ppSelectionShapes Then
    MsgBox "Please select two charts."
    Exit Sub
End If

If ActiveWindow.Selection.ShapeRange.Count <> 2 Then
    MsgBox "Please select two charts."
    Exit Sub
End If

Set sourceChart = ActiveWindow.Selection.ShapeRange(1).Chart
Set destChart = ActiveWindow.Selection.ShapeRange(2).Chart
    
''    If .HasChart = True Then
''    End If

    '' Chart size
    ActiveWindow.Selection.ShapeRange(2).Width = ActiveWindow.Selection.ShapeRange(1).Width
    ActiveWindow.Selection.ShapeRange(2).Height = ActiveWindow.Selection.ShapeRange(1).Height
    
'' Adjust plot area size and fill

    With destChart.PlotArea
        .Top = sourceChart.PlotArea.Top
        .Left = sourceChart.PlotArea.Left
        .Height = sourceChart.PlotArea.Height
        .Width = sourceChart.PlotArea.Width
        
        
        .InsideWidth = sourceChart.PlotArea.InsideWidth
        .InsideHeight = sourceChart.PlotArea.InsideHeight
        .InsideLeft = sourceChart.PlotArea.InsideLeft
        .InsideTop = sourceChart.PlotArea.InsideTop

        End With
        
        With destChart.Format
        .TextFrame2.TextRange.Font.Size = sourceChart.Format.TextFrame2.TextRange.Font.Size
        .TextFrame2.TextRange.Font.Name = sourceChart.Format.TextFrame2.TextRange.Font.Name
        End With
        
        

''        .Format.Fill.ForeColor.RGB = sourceChart.PlotArea.Format.Fill.ForeColor.RGB
''        .Format.Line.ForeColor.RGB = sourceChart.PlotArea.Format.Line.ForeColor.RGB
    
    
'    End With
    
    With destChart.ChartTitle.Format
            .TextFrame2.TextRange.Font.Size = sourceChart.ChartTitle.Format.TextFrame2.TextRange.Font.Size
    End With
    
    With destChart.ChartArea.Format
    
        .TextFrame2.TextRange.Font.Size = sourceChart.ChartArea.Format.TextFrame2.TextRange.Font.Size
        
    End With
    
    
    With destChart.Legend
        .Position = sourceChart.Legend.Position
        .Left = sourceChart.Legend.Left
        .Top = sourceChart.Legend.Top
        .Width = sourceChart.Legend.Width
        .Height = sourceChart.Legend.Height
    End With


'With destChart.Floor   'commented out as i keep on getting "Method failed"
'
'.Format.TextFrame2.TextRange.Font.Size = sourceChart.Floor.Format.TextFrame2.TextRange.Font.Size
'
'End With

With destChart.Format
.TextFrame2.TextRange.Font.Size = sourceChart.Format.TextFrame2.TextRange.Font.Size

End With


End Sub