虽然明显的选择声明,但VBA不会选择范围

时间:2014-12-27 10:34:09

标签: vba excel-vba access-vba excel

我从pivotcache创建自动数据透视表,从而通过adodb连接导入其记录集。

我需要对日期字段进行分组,并通过.pivotselect方法在线找到一种方法。代码工作正常,但是excel似乎没有选择工作表中的pivottable以某种方式,即使选择了pivottable数据。如果选择另一个工作表然后运行该过程,则会导致错误。

不应该是pivottable.pivotselect也会自动选择工作表吗?我已经通过张贴(" Pivot")暂时解决了它。在日期分组代码之前选择。怎么会遇到这个问题呢?当前代码基于宏录制器生成的代码。

代码

Private Sub PivotAccessADODB()
' Link Pivottable to access database, successfull!

Const ConnectionPath As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\name\Desktop\DataBase.accdb;Persist Security Info=False;"


    Dim DataConnection As ADODB.Connection: Set DataConnection = New ADODB.Connection
    Dim RecordSet As ADODB.RecordSet: Set RecordSet = New ADODB.RecordSet

    DataConnection.ConnectionString = ConnectionPath
    DataConnection.Open

    Dim SQLString As String: SQLString = "SELECT * FROM ALFA"

    With RecordSet
        .ActiveConnection = DataConnection
        .Source = SQLString
        .LockType = adLockReadOnly
        .CursorType = adOpenForwardOnly
        .Open
    End With

' Initiate accept of external data
Dim PTCache As PivotCache

Set PTCache = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set PTCache.RecordSet = RecordSet

'----------------------------------'
'First Pivot Table export procedure
Dim PT As PivotTable: Set PT = PTCache.CreatePivotTable(Sheets("Pivot").Range("A1"), "PivotTable#1")

With PT
    .PivotFields("Date").Orientation = xlRowField
    .PivotFields("Date").Position = 1

    Sheets("pivot").Select ' Bypass selection grouping error, temporary solution as of 2014-12-26
    PT.PivotSelect "Date[All]", xlLabelOnly + xlFirstRow, True
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, False, False)

    .PivotFields("Adj Close").Orientation = xlDataField
        .PivotFields("Sum of Adj Close").Calculation = xlPercentDifferenceFrom
        .PivotFields("Sum of Adj Close").BaseItem = "(previous)"

    .PivotFields("Volume").Orientation = xlDataField
        .PivotFields("Sum of Volume").Calculation = xlPercentDifferenceFrom
        .PivotFields("Sum of Volume").BaseItem = "(previous)"
End With

    Dim wst As Worksheet: Set wst = Sheets("Mainwindow")
    Dim wshape As Shape
    Set wshape = wst.Shapes.AddChart2(286, xl3DColumnClustered, wst.Range("A24").Left, wst.Range("A24").Top, _
    wst.Range("A24:Q24").Width, wst.Range("A24:A39").Height)

With wshape.Chart
    .SetSourceData Source:=PT.TableRange1
    .ClearToMatchStyle
    .ChartStyle = 291
    .ApplyLayout (1)
    .ChartTitle.Text = "Difference from previous month in percentage"
    .ChartTitle.Format.TextFrame2.TextRange.Font.Size = 14
End With

'-----------------------------------'
'Second Pivot Table export procedure'



'Cleanup
 RecordSet.Close
 DataConnection.Close
 Set RecordSet = Nothing
 Set DataConnection = Nothing

End Sub

1 个答案:

答案 0 :(得分:1)

确保对Worksheet对象进行尺寸标注并将其设置为具有数据透视表的任何工作表:

Dim wkb    As Excel.Workheet

Set wkb = ActiveWorkbook.Worksheet("Me")

wkb.Activate 'wkb.Select may give focus but doesn't register as the active worksheet object.

<PT Code>

Set wkb = Nothing