如何在MS Word中编写VBA宏以在表格中插入饼图

Question

我正在尝试在MS Word中编写一个VBA宏，该宏创建一个在特定单元格内插入饼图的表格。饼图的数据将由宏请求。下面是我到目前为止，但我很难弄清楚如何在表格内创建饼图。

Sub InsertChart()
' Inserts a custom chart

Dim data1 As Variant
data1 = InputBox("What was the Moving Water damage value (enter as 0.0 - 1.0).")

Dim data2 As Variant
data2 = InputBox("What was the Settlement damage value (enter as 0.0 - 1.0).")

Dim data3 As Variant
data3 = InputBox("What was the Pre-Exisiting damage value (enter as 0.0 - 1.0).")


Dim i As Integer

i = ActiveDocument.Tables.Count
i = i + 1

' Create table if there is more than 1 table
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=5, NumColumns:=2
ActiveDocument.Tables(i).Cell(1, 2).Split NumColumns:=3
ActiveDocument.Tables(i).Cell(1, 3).Range.Text = "Quantity (Measurable Area):"
ActiveDocument.Tables(i).Cell(2, 1).Range.Text = "Description:"
ActiveDocument.Tables(i).Cell(3, 1).Range.Text = "Analysis:"
ActiveDocument.Tables(i).Cell(4, 1).Range.Text = "Cause(s) of Damage:"
ActiveDocument.Tables(i).Cell(5, 1).Range.Text = "Recommended Repairs:"

With ActiveDocument.Tables(i)
    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
    .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
    .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
End With

Dim small As Boolean
small = False
Dim twoSeries As Boolean
twoSeries = False
Dim pieChart As Boolean
pieChart = True

Dim salesChart As Chart
Dim chartWorkSheet As Excel.Worksheet


With ActiveDocument.Tables(i)
    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
    .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
    .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
End With

' Add in a new chart
Set salesChart = ActiveDocument.InlineShapes.AddChart.Chart
Set chartWorkSheet = salesChart.ChartData.Workbook.WorkSheets(1)

' Resize the chart area
chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:B4")

' Rename Series 1 as Sales
chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Damage"

' Add data to the chart
chartWorkSheet.Range("A2").FormulaR1C1 = "Moving Water"
chartWorkSheet.Range("A3").FormulaR1C1 = "Settlement"
chartWorkSheet.Range("A4").FormulaR1C1 = "Pre-Exisiting"
chartWorkSheet.Range("B2").FormulaR1C1 = data1
chartWorkSheet.Range("B3").FormulaR1C1 = data2
chartWorkSheet.Range("B4").FormulaR1C1 = data3


' Quit Excel, since we no longer need it
salesChart.ChartData.Workbook.Application.Quit

' Put a box around the legend
salesChart.Legend.Format.Line.Visible = msoCTrue

' Fill the background with theme color accent 1
With salesChart.ChartArea.Format.Fill
    .Visible = msoTrue
    .Solid
    .ForeColor.ObjectThemeColor = wdThemeColorAccent1
End With

' Add a title and format it
salesChart.HasTitle = True
With salesChart.ChartTitle
    .Characters.Font.Italic = True
    .Characters.Font.Size = 18
    .Characters.Font.color = RGB(0, 0, 100)
    .Text = "Damage"
End With


If small Then
' Size and move the chart
With salesChart.Parent
    .Left = 100
    .Width = 300
    .Height = 150
End With
End If

If pieChart Then
' Set chart type
    salesChart.ChartType = xl3DPie
End If

'Move chart to specific cell
ActiveDocument.Tables(i).Cell(1, 1).Select
Selection.Cut

ActiveDocument.Tables(i).Cell(4, 2).Select
Selection.Paste

ActiveDocument.Tables(i).Cell(1, 1).Range.Text = "Location:"


End Sub

Answer 1

试试这个

salesChart.CopyPicture
salesChart.Delete
tbl.Cell(1, 1).Range.Select
Selection.PasteAndFormat (wdChartPicture)
Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)

在最后End If之后和End Sub

之前添加此内容

<强>截图

Answer 2

在我看来，你可以将这一行放在End Sub之前：

salesChart.Parent.ConvertToInlineShape

它将图表从形状转换为将位于表格内的inlines形状。 我确实测试了它的空文档，它可以做你想要的。

您可以稍后将此行添加到自动调整单元格/列：

ActiveDocument.Tables(1).Columns(1).AutoFit

编辑转换为表1中的某个单元格。

以这种方式进行此转换：

Dim InSHP As InlineShape
Set InSHP = salesChart.Parent.ConvertToInlineShape
InSHP.Range.Cut
ActiveDocument.Tables(1).Cell(4, 2).Range.Paste