VBA在每页中的相同位置插入图表

时间:2014-10-30 17:41:56

标签: vba ms-word word-vba

我从word文档中的表中提取了每个单元格的值,然后根据这些值创建了图表。图表很好。

但是,它会在第一页保留插入内容。有谁知道如何将我的图表插入每页的相同位置?

Mail Merge生成的word文档。这会导致问题吗?

另外,有人知道如何将图表插入表格单元格吗?

Dim pge As Page
Dim i As Integer
i = 3
Dim j As Integer
j = 1

For peg = 1 To Selection.Information(wdNumberOfPagesInDocument)
        Dim tTable As Table

        Set tTable = ActiveDocument.Tables(i)
        Set cTable = ActiveDocument.Tables(j)


        Dim wChart As Chart
        Dim chartWorkSheet As Excel.Worksheet
        Dim ThisYrSumCon As Integer
        Dim ThisYrWinCon As Integer
        Dim PreYrSumCon As Integer
        Dim PreYrWinCon As Integer
        Dim BefPreYrSumCon As Integer
        Dim BefPreYrWinCon As Integer

        '•
        ThisYrSumCon = CInt(Left(tTable.Cell(2, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
        ThisYrWinCon = CInt(Left(tTable.Cell(3, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text) - 1))
        PreYrSumCon = CInt(Left(tTable.Cell(2, 3).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
        PreYrWinCon = CInt(Left(tTable.Cell(3, 3).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
        BePreYrSumCon = CInt(Left(tTable.Cell(2, 4).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
        BePreYrWinCon = CInt(Left(tTable.Cell(3, 4).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))

        'MsgBox (ThisYrSumCon)

        'cTable.Cell(3, 4).Range.Text = "test"
        'cTable.Cell(12, 3).Range.Text = "test"


        Set wChart = ActiveDocument.Shapes.AddChart.Chart
        With wChart.Parent
            .Top = 105
            .Left = 205
            .Width = 300
            .Height = 150
        End With



        Set chartWorkSheet = wChart.ChartData.Workbook.WorkSheets(1)
        chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:G2")
        chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Water Consumption Records"
        wChart.ChartType = xlColumnClustered


        chartWorkSheet.Range("A1").FormulaR1C1 = ""
        chartWorkSheet.Range("B1").FormulaR1C1 = "2012 Summer"
        chartWorkSheet.Range("C1").FormulaR1C1 = "2012 Winter"
        chartWorkSheet.Range("D1").FormulaR1C1 = "2013 Summer"
        chartWorkSheet.Range("E1").FormulaR1C1 = "2013 Winter"
        chartWorkSheet.Range("F1").FormulaR1C1 = "2014 Summer"
        chartWorkSheet.Range("G1").FormulaR1C1 = "2014 Winter"

        chartWorkSheet.Range("A2").FormulaR1C1 = ""
        chartWorkSheet.Range("B2").FormulaR1C1 = BePreYrSumCon
        chartWorkSheet.Range("C2").FormulaR1C1 = BePreYrWinCon
        chartWorkSheet.Range("D2").FormulaR1C1 = PreYrSumCon
        chartWorkSheet.Range("E2").FormulaR1C1 = PreYrWinCon
        chartWorkSheet.Range("F2").FormulaR1C1 = ThisYrSumCon
        chartWorkSheet.Range("G2").FormulaR1C1 = ThisYrWinCon

        wChart.ChartData.Workbook.Application.Quit


        i = i + 5
        j = j + 5
        Selection.GoTo What:=wdGoToPage, Which:=lNextPage


Next

1 个答案:

答案 0 :(得分:0)

哈哈,我很高兴我可以回答我自己的问题......:)

以下是在每页中使用相同格式字表创建图表的答案,并将图表放在每页的相同位置。

i Integer让我在每个页面中找到相同的表格。

Dim Rng As Range, pg As Long
Dim i As Integer
i = 3

With ActiveDocument
    Set Rng = .Range(0, 0)
    For pg = 1 To .ComputeStatistics(wdStatisticPages)
        Set Rng = Rng.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pg)

        Rng.Collapse wdCollapseStart

        Dim tTable As Table
        Set tTable = ActiveDocument.Tables(i)

        Dim wChart As Chart
        Dim chartWorkSheet As Excel.Worksheet
        Dim ThisYrSumCon As Integer
        Dim ThisYrWinCon As Integer
        Dim PreYrSumCon As Integer
        Dim PreYrWinCon As Integer
        Dim BefPreYrSumCon As Integer
        Dim BefPreYrWinCon As Integer

        ThisYrSumCon = CInt(Left(tTable.Cell(2, 2).Range.Text, Len(tTable.Cell(2, 2).Range.Text) - 1))
        ThisYrWinCon = CInt(Left(tTable.Cell(3, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text) - 1))
        PreYrSumCon = CInt(Left(tTable.Cell(2, 3).Range.Text, Len(tTable.Cell(2, 3).Range.Text) - 1))
        PreYrWinCon = CInt(Left(tTable.Cell(3, 3).Range.Text, Len(tTable.Cell(3, 3).Range.Text) - 1))
        BePreYrSumCon = CInt(Left(tTable.Cell(2, 4).Range.Text, Len(tTable.Cell(2, 4).Range.Text) - 1))
        BePreYrWinCon = CInt(Left(tTable.Cell(3, 4).Range.Text, Len(tTable.Cell(3, 4).Range.Text) - 1))

        Set wChart = .Shapes.AddChart(xlColumnClustered, 270, 105, 230, 150, Rng).Chart
        Set chartWorkSheet = wChart.ChartData.Workbook.WorkSheets(1)
        chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:G2")
        chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Water Consumption Records"


        chartWorkSheet.Range("A1").FormulaR1C1 = ""
        chartWorkSheet.Range("B1").FormulaR1C1 = "2012 Summer"
        chartWorkSheet.Range("C1").FormulaR1C1 = "2012 Winter"
        chartWorkSheet.Range("D1").FormulaR1C1 = "2013 Summer"
        chartWorkSheet.Range("E1").FormulaR1C1 = "2013 Winter"
        chartWorkSheet.Range("F1").FormulaR1C1 = "2014 Summer"
        chartWorkSheet.Range("G1").FormulaR1C1 = "2014 Winter"

        chartWorkSheet.Range("A2").FormulaR1C1 = ""
        chartWorkSheet.Range("B2").FormulaR1C1 = BePreYrSumCon
        chartWorkSheet.Range("C2").FormulaR1C1 = BePreYrWinCon
        chartWorkSheet.Range("D2").FormulaR1C1 = PreYrSumCon
        chartWorkSheet.Range("E2").FormulaR1C1 = PreYrWinCon
        chartWorkSheet.Range("F2").FormulaR1C1 = ThisYrSumCon
        chartWorkSheet.Range("G2").FormulaR1C1 = ThisYrWinCon

        wChart.ChartData.Workbook.Application.Quit

        i = i + 5
        j = j + 5

    Next
End With