This is not code you'll use often, and you definitely won't find it anywhere else, but if you've ever wanted to use an Excel chart in Word with the ability to edit the chart text, this is the best way to do it. Suppose for example that you or someone else has created a chart that has a figure number below the chart title, but you won't know what figure number to use until the entire Word document is completed.

The same approach works for PowerPoint too, but it's much simpler to implement. Just paste in a chart as an enhanced metafile and right-click on it, you can "ungroup" it just like in Word. There's not much need for formatting since PowerPoint text is usually in textboxes next to charts, not surrounding them.


Use this to copy chart from Excel:

Public Sub CopyChartWithBorders()
 Call SetApp(Updating, TurnOff): Call SetApp(Events, TurnOff)
   
    If Not gvColors Then SetCustomColors
   
    Dim i As Byte
    With ActiveSheet
        For i = 1 To .ChartObjects.Count
            If .ChartObjects(i).Visible Then FixChartColors (i): .ChartObjects(i).Select
        Next
    End With

    'reposition legend (in case it moved when series were added/removed, etc)
    On Error Resume Next 'pie charts don't have legends
    With ActiveChart.Legend
        .Left = 1: .Top = 39
    End With
   
    Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    Application.Goto Range("A1"), True
   
 Call SetApp(Updating, TurnOn): Call SetApp(Events, TurnOn)
    CloseFileTest
End Sub

Use this to paste the chart into Word:

Public Sub InsertChartFromClipboard()
'uses gvChartPosition public variable and fChartPosition form to set the variable
'adjust constants as needed
    Application.ScreenUpdating = False
   
    On Error GoTo ExitNow
    ActiveDocument.UndoClear
    Selection.Collapse
    Selection.TypeParagraph
   
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    If (Selection.InlineShapes.Count = 0) Then Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    On Error GoTo Failed
    Dim ChartWidth&, oChart: Set oChart = Selection.InlineShapes(Selection.InlineShapes.Count)
    On Error Resume Next
    
    'scale
    With oChart
        .Select: .ScaleHeight = 100: .ScaleWidth = 100
    End With
    ChartWidth = oChart.Width
    
    gvChartPosition = wdShapeLeft 'set default
    If (ChartWidth < 400) Then: Application.ScreenRefresh: fChartLocation.Show
   
    With oChart
        .WrapAroundText = True: .AllowOverlap = False
    End With

    Dim TryCount&: On Error GoTo TryAgain
    Selection.InlineShapes(1).ConvertToShape

    Selection.ShapeRange.Ungroup.Select
   
    With Selection.ShapeRange
        .LockAspectRatio = msoTrue
        .LockAnchor = False
        With .WrapFormat
            .AllowOverlap = True
            .Side = wdWrapBoth
            .DistanceTop = InchesToPoints(0)
            .DistanceBottom = InchesToPoints(0)
            .DistanceLeft = InchesToPoints(0.13)
            .DistanceRight = InchesToPoints(0.13)
            .Type = wdWrapSquare
        End With
    End With

    'make chart move with text (this must be in a separate with)
    With Selection.ShapeRange
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
        .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
        .Left = gvChartPosition
        .WrapFormat.Type = wdWrapSquare
    End With

GiveUp:

    'indent
    If (gvChartPosition <> wdShapeCenter) Then
        With Selection.ParagraphFormat
            If (gvChartPosition = wdShapeLeft) Then
                .LeftIndent = InchesToPoints(-0.07)
            Else
                .RightIndent = InchesToPoints(0)
            End If
        End With
    End If

    Selection.Collapse

    Application.ScreenUpdating = True
    Exit Sub
TryAgain:
    TryCount = TryCount + 1
    If (TryCount < 10) Then Resume Next Else GoTo GiveUp
Failed:
    ActiveDocument.Undo (10) 'undo paste since it wasn't a chart
    Application.ScreenUpdating = True
    MsgBox ("Clipboard does not contain a chart.")
End Sub