Question

使用包含图表的vba构建Word报告。问题是找出如何在特定点int报告中插入图表。无论我尝试什么，图表最终都在第1页。我需要它，例如请放在第2页。请参阅下面的代码。与图表放置完美结合

Public Function gbAuditReportGraphs(ByVal lAuditID As Long) As Boolean
'
' NRE 07-Oct-2017
'
' Purpose : Prototype graphs in Audit
' See also
' Mantis 2250
' https://msdn.microsoft.com/en-us/library/office/ff629397(v=office.14).aspx
' Note : This version outputs to a word document
' Mods


Dim objChart As chart
Dim chartWorkSheet As Excel.Worksheet
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim chSeries As Series
Dim rng As Range
Dim i As Integer
Dim clsAudit_ As New clsAudit
Dim clsRig_ As New clsRig
Dim bOk As Boolean
Dim vRigName As Variant

On Error GoTo eh

    ' Initialise function as false
    gbAuditReportGraphs = False

    clsAudit_.AuditID = lAuditID
    bOk = clsAudit_.mbLoad
    clsRig_.RigID = clsAudit_.RigID
    bOk = clsRig_.mbLoad
    vRigName = clsRig_.RigName

    ssql = " SELECT cl.checklistdesc" _
          & "      , COUNT(*) AS nccount " _
          & "   FROM tbltask t " _
          & "      , tblchecklist cl" _
          & "  WHERE cl.auditid=t.auditid" _
          & "    AND cl.checklistid = t.checklistid" _
          & "    AND cl.auditid = " & lAuditID _
          & "    AND t.tasktype = '" & gsO & "'" _
          & "    AND t.taskstatus>0" _
          & "  GROUP BY cl.checklistdesc" _
          & "  ORDER BY 1"

    Debug.Print "modADCForms.gbAuditReportGraphs, ssql = " & ssql

    ' Declare the Word Application and Document
   Set mobjWordApp = New Word.Application
   Set mobjWordDoc = mobjWordApp.Documents.Add
   mobjWordDoc.SetCompatibilityMode wdWord2010

    ' Add page numbers
    With mobjWordDoc.Sections(1)
      .Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberRight, FirstPage:=True
       'Add Date
      .Footers(wdHeaderFooterPrimary).Range.InsertBefore Format(Date, "dd-MMM-YYYY") & Chr(9) & Chr(9)
      .Footers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment = wdAlignParagraphLeft
      .Footers(wdHeaderFooterPrimary).Range.Font.Name = "ForzaMedium"
      .Footers(wdHeaderFooterPrimary).Range.Font.Size = 12
    End With

    Debug.Print "modADCForms.gbAuditReportGraphs,0"

    modADCForms.gInserttext wdStyleNormal, "Page 1", wdColorBlack
    modADCForms.gInsertPage
    modADCForms.gInserttext wdStyleNormal, "Page 2", wdColorBlack

    Debug.Print "modADCForms.gbAuditReportGraphs 1"

    Set rng = mobjWordDoc.Range

    With rng
        .Collapse wdCollapseEnd
        .Collapse Direction:=wdCollapseEnd
        .InsertParagraphAfter
        .Collapse Direction:=wdCollapseEnd
    End With


    ' Set objChart = mobjWordDoc.Shapes.AddChart(xl3DPie, , 60, , 450, rng) -- type mismatch
    Set objChart = mobjWordDoc.Shapes.AddChart.chart
    objChart.ChartType = xlPie
    objChart.HasLegend = False

    Debug.Print "modADCForms.gbAuditReportGraphs 2"

    ' Create chart worksheet
    Set chartWorkSheet = objChart.ChartData.Workbook.Worksheets(1)
    ' Add a header
    chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = vRigName & " Non-Conformance Distribution"

    rs.Open ssql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
        i = 2
        Do While Not rs.EOF()
            chartWorkSheet.Range("A" & i).FormulaR1C1 = rs.Fields("checklistdesc")
            chartWorkSheet.Range("B" & i).FormulaR1C1 = rs.Fields("nccount")
            i = i + 1
            rs.MoveNext
        Loop
    End If
    rs.Close

    chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:B" & i - 1)

    ' Configure chart to show the values
    With objChart
        With .SeriesCollection(1)
            .HasDataLabels = True
            .DataLabels.ShowValue = True
            .HasLeaderLines = True
            .DataLabels.ShowCategoryName = True
        End With
    End With

    ' set the fonts
    Debug.Print " Setting the fonts of the labels ..1."

    objChart.ChartArea.Font.Size = 9
    objChart.ChartArea.Font.Name = gsFontForzaMedium

    ' Set the location of the chart
    With objChart.Parent
        .Height = 450
        .Top = 60
    End With


    ' show the document
    mobjWordApp.visible = True

    ' Close the spreadsheet chart object
    objChart.ChartData.Workbook.Application.Quit

    ' Clear the objects
    Set rs = Nothing

    Set clsRig_ = Nothing
    Set clsAudit_ = Nothing

    ' Set function to status OK
    gbAuditReportGraphs = True

ex:
    Exit Function

eh:
    gError "Problem creating audit report graphs", "modADCForms", "gbAuditReportGraphs", Err, Error
    Resume ex

End Function

Answer 1

辛比，我已经接受了你的价值建议并修复了它：）

传入范围
的参数
Public function gbAuditReportGraphs（ByVal lAuditID As Long，rng As Range）As Boolean
将图表创建为内嵌形状

设置objChart = mobjWordDoc.InlineShapes.AddChart.Chart objChart.ChartType = xlPie
使用
等代码设置大小
使用mobjWordApp.ActiveDocument .InlineShapes（1）.Height = 450 .InlineShapes（1）.Width = 400
结束
将图表复制并粘贴到指定范围

objChart.Copy rng.Paste
删除原始

objChart.Delete

我找不到关于如何做到这一点的其他建议;也许这篇文章会对其他人有所帮助。

Answer 2

使解决方案更加健壮的一个提示：通常，您无法确定插入的InlineShape是文档中的第一个，因此ActiveDocument.InlineShapes(1)不可靠。最好声明一个InlineShape对象并将属于图表的InlineShape分配给它，这样你就可以确定你正在使用正确的InlineShape：

'1.Pass in parameter of the range
Public Function gbAuditReportGraphs(ByVal lAuditID As Long, _
                                    rng As Range) As Boolean
  Dim objChart as Word.Chart
  Dim objInlineShape as Word.InlineShape

  '2.Create chart as an inline shape
   Set objChart = mobjWordDoc.InlineShapes.AddChart.Chart 
   objChart.ChartType = xlPie

  '3.Set the size with code such as
  Set objInlineShape = objChart.Parent
  With objInlineShape
    .Height = 450 
    .Width = 400 
  End With

  '4.Copy and paste chart into the specified range
  objChart.Copy 
  rng.Paste

  '5.Delete the original
  objChart.Delete

End Function

MSWord vba图表位置

2 个答案: