Public Sub AddMSGraphObject()
  Const cBMName As String = "tmGraph1"

  Dim objWDDoc        As Word.Document
  Dim objWDRange      As Word.Range
  Dim objIShape       As Word.InlineShape

  Dim objOLEChart     As Object
  Dim objOLEDataSht   As Object

  Const xl3DColumn = -4100

  Dim avarHeaderRows  As Variant
  Dim avarHeaderCols  As Variant

  Dim nRowsCnt        As Long
  Dim nColsCnt        As Integer
  Dim nRow            As Long
  Dim nCol            As Integer

  Set objWDDoc = ActiveDocument

  If Not objWDDoc.Bookmarks.Exists(cBMName) Then
    MsgBox "Die Textmarke '" & cBMName & " 'ist im " & _
           "aktiven Dokument nicht vorhanden !!!", _
           vbOKOnly + vbExclamation, _
           Title:="Demo - MS-Graph-Objekt einfügen"
    Set objWDDoc = Nothing
    Exit Sub
  End If

  Application.ScreenUpdating = False

  Set objWDRange = objWDDoc.Bookmarks(cBMName).Range
  objWDRange.Text = ""

  Set objIShape = objWDDoc.InlineShapes.AddOLEObject( _
        ClassType:="MSGraph.Chart.8", FileName:="", _
        Linktofile:=False, DisplayAsIcon:=False, _
        Range:=objWDRange)

  objWDDoc.Bookmarks.Add Name:=cBMName, Range:=objIShape.Range

  With objIShape
    .Width = 350
    .Height = 200
  End With

  Set objOLEChart = objIShape.OLEFormat.Object
  With objOLEChart
    .ChartArea.Font.Size = 8
    .ChartType = xl3DColumn
    .HasLegend = True
    .ApplyDataLabels
    .HasTitle = True
    .ChartTitle.Text = "Demo - MS Graph Object"
    .ChartTitle.Font.Size = 12
    .ChartArea.AutoScaleFont = False

    .SeriesCollection(1).Interior.ColorIndex = 36
    .SeriesCollection(2).Interior.ColorIndex = 34
    .SeriesCollection(3).Interior.ColorIndex = 38
  End With

  Set objOLEDataSht = objOLEChart.Application.DataSheet

  nRowsCnt = 2
  nColsCnt = 3

  avarHeaderRows = Array("Zeile 1", "Zeile 2", "Zeile 3")
  avarHeaderCols = _
    Array("Spalte 1", "Spalte 2", "Spalte 3", "Spalte 4")

  With objOLEDataSht
    .Cells.Clear

    For nRow = 0 To nRowsCnt
      .Cells(nRow + 2, 1).Value = avarHeaderRows(nRow)
    Next nRow

    For nCol = 0 To nColsCnt
      .Cells(1, nCol + 2).Value = avarHeaderCols(nCol)
    Next nCol

    nRowsCnt = nRowsCnt + 2
    nColsCnt = nColsCnt + 2

    For nRow = 2 To nRowsCnt
      For nCol = 2 To nColsCnt
        .Cells(nRow, nCol).Value = Int((100 * Rnd) + 1)
      Next nCol
    Next nRow
  End With

  With objOLEChart.Application
    .Update
    .Quit
  End With

  Application.ScreenUpdating = True

  Set objOLEDataSht = Nothing
  Set objOLEChart = Nothing
  Set objIShape = Nothing
  Set objWDRange = Nothing
  Set objWDDoc = Nothing
End Sub