Ошибка MS Access 434 перестает создавать xlBarStacked в Excel

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