Question

从最近几周开始，我一直在处理导出查询并创建图表的问题。我必须将图表设计更改为xlBarStacked。是我的问题

下面的代码运行良好：

Sub exportqrycreatechart()
Dim xl, wb, ws, ch, mychart, chart, qry_01 As Object
Dim sExcelWB As String

   Set xl = CreateObject("excel.application")
   On Error Resume Next

   Err.Clear
   On Error GoTo 0
   sExcelWB = CurrentProject.Path & "qry_01"
   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_01", sExcelWB, True

   Set wb = xl.Workbooks.Open(sExcelWB)
   Set ws = wb.Sheets("qry_01")
   Set ch = ws.Shapes.AddChart

   Set mychart = ws.ChartObjects("Chart 1")
   ws.Columns.AutoFit
   ws.Columns("B:C").HorizontalAlignment = xlCenter
   ws.Columns(3).TextToColumns , , , , -1, 0, 0, 0
   ws.Columns(4).TextToColumns , , , , -1, 0, 0, 0

  wb.Save
  xl.Visible = True
  xl.UserControl = True
  Set ws = Nothing
  Set wb = Nothing
End Sub

但是，当我尝试将图表更改为xlBarStacked时，发生了“错误434对象不支持此属性或方法”。

With ch
    .ChartGroups(1).GapWidth = 59
    .ChartArea.Height = 400
    .ChartArea.Width = 700
    .ChartArea.Top = 1
    .FullSeriesCollection(1).Delete '

    .SeriesCollection.NewSeries
    .FullSeriesCollection(1).Values = Range("A2", Range("A2").End(xlDown))

    .SeriesCollection.NewSeries
    .FullSeriesCollection(2).Values = Range("D2", Range("D2").End(xlDown))
    .FullSeriesCollection(2).XValues = Range("C2", Range("C2").End(xlDown))
    .Axes(xlCategory).ReversePlotOrder = True
End with

错误434发生在：

.ChartGroups(1).GapWidth = 59

所有行都向下

这里是所有代码：

Option Compare Database
Option Explicit

Sub exportqrycreatechart()
    Dim xl, wb, ws, ch, mychart, chart, qry_01 As Object
    Dim sExcelWB As String

       Set xl = CreateObject("excel.application")
       On Error Resume Next

       Err.Clear
       On Error GoTo 0
       sExcelWB = CurrentProject.Path & "qry_01"
       DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_01", sExcelWB, True

       Set wb = xl.Workbooks.Open(sExcelWB)
       Set ws = wb.Sheets("qry_01")
       Set ch = ws.Shapes.AddChart

       Set mychart = ws.ChartObjects("Chart 1")
       ws.Columns.AutoFit
       ws.Columns("B:C").HorizontalAlignment = xlCenter
       ws.Columns(3).TextToColumns , , , , -1, 0, 0, 0
       ws.Columns(4).TextToColumns , , , , -1, 0, 0, 0

         With ch
            .ChartGroups(1).GapWidth = 59
            .ChartArea.Height = 400
            .ChartArea.Width = 700
            .ChartArea.Top = 1
            .FullSeriesCollection(1).Delete '

            .SeriesCollection.NewSeries
            .FullSeriesCollection(1).Values = Range("A2", Range("A2").End(xlDown))

            .SeriesCollection.NewSeries
            .FullSeriesCollection(2).Values = Range("D2", Range("D2").End(xlDown))
            .FullSeriesCollection(2).XValues = Range("C2", Range("C2").End(xlDown))
            .Axes(xlCategory).ReversePlotOrder = True
         End with

      wb.Save
      xl.Visible = True
      xl.UserControl = True
      Set ws = Nothing
      Set wb = Nothing
End Sub

谁能告诉我如何解决这个问题？我将非常感谢

Answer 1

您在这里看到了3个问题。首先，Shapes.Addchart返回一个Shape，而不是一个Chart，这就是为什么会收到438错误的原因。其次，您有几个不合格的excel对象引用，这将导致您具有孤立的Excel进程。第三，您似乎延迟绑定，但是您尝试使用Excel库中的常量，该常量在您的代码中没有任何价值。

尝试以下方法：

Option Compare Database
Option Explicit

Sub exportqrycreatechart()
    Dim xl, wb, ws, ch, mychart, chart, qry_01 As Object
    Dim sExcelWB As String
    Const xlCenter As Long = -4108
    Const xlCategory As Long = 1
    Const xlDown As Long = -4121

       Set xl = CreateObject("excel.application")
       On Error Resume Next

       Err.Clear
       On Error GoTo 0
       sExcelWB = CurrentProject.Path & "\qry_01.xlsx"
       DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_01", sExcelWB, True

       Set wb = xl.Workbooks.Open(sExcelWB)
       Set ws = wb.Sheets("qry_01")
       Set ch = ws.Shapes.AddChart.chart

       Set mychart = ws.ChartObjects("Chart 1")
       ws.Columns.AutoFit
       ws.Columns("B:C").HorizontalAlignment = xlCenter
       ws.Columns(3).TextToColumns , , , , -1, 0, 0, 0
       ws.Columns(4).TextToColumns , , , , -1, 0, 0, 0

         With ch
            .ChartGroups(1).GapWidth = 59
            .ChartArea.Height = 400
            .ChartArea.Width = 700
            .ChartArea.Top = 1
            .SeriesCollection(1).Delete '

            .SeriesCollection.NewSeries
            .SeriesCollection(1).Values = ws.Range("A2", ws.Range("A2").End(xlDown))

            .SeriesCollection.NewSeries
            .SeriesCollection(2).Values = ws.Range("D2", ws.Range("D2").End(xlDown))
            .SeriesCollection(2).XValues = ws.Range("C2", ws.Range("C2").End(xlDown))
            .Axes(xlCategory).ReversePlotOrder = True
         End With

      wb.Save
      xl.Visible = True
      xl.UserControl = True
      Set ws = Nothing
      Set wb = Nothing
End Sub

MS Access错误434停止在Excel中创建xlBarStacked

1 个答案: