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

Posted 2023-05-07

【中文标题】MS Access 错误 434 停止在 Excel 中创建 xlBarStacked

【英文标题】：MS Access Error 434 stops creating xlBarStacked in Excel

【发布时间】：2018-10-22 09:03:35

【问题描述】：

自过去几周以来，我一直在处理导出查询并创建图表。 我必须将图表设计更改为 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

谁能告诉我如何解决这个问题？我将不胜感激

【参考方案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

【讨论】：

此处再次出现错误 438：“使用 ch .ChartGroups(1).GapWidth = 59”。这条线是错误发生的地方。我仍然很困惑。如果我省略这一行，则错误发生在下一行等等。

@SebastianSalazar 您是用我的代码替换您的代码，还是尝试添加更改后的代码行？

我刚刚进一步修改了代码，因为路径和工作簿名称也有错误（所以我很惊讶你能做到这一点！）并在 2010 年毫无问题地运行它，在将 FullSeriescollection 更改为 Seriescollection 之后，因为它是在 2010 年之后添加的。您使用的是什么版本？

我在 Excel 中使用 MS Office 2016，我复制了带有宏记录的代码 on.´ There, I saw .fullSeriesCollection´ 我移动了 seriescollection´ code and "Set axis min-max values code block" to within With ch - End´ With 但是，执行代码时，结束后Excel 中的任务管理..'错误 462 远程服务器机器不存在或不可用'，出现在这一行 .SeriesCollection(2).XValues = ws.Range("C2", ws.Range("C2").End(xlDown))´ Now, will VBA show in the Chart the CurrentRegion Range at a time with my seriescollection´ data 我的代码范围？

确保在运行代码之前已终止所有 Excel 进程，因为您的代码会留下一些运行状态。