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

Question

我从word文档中的表格中提取每个单元格的值，然后基于这些值创建图表。图表很好。

但是，它在第​​一页保持插入。有谁知道我怎样才能将我的图表插入每个页面的相同位置？

邮件合并生成的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 

Answer 1

大声笑，我很高兴我能回答我的问题... :)

下面是在每个页面创建图表的基础上相同的格式字表的答案，并把图表在同一地点每页。

我整数是为我找到每页中的同一张表。

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