Страницы: 1
RSS
Макрос для создания сводной таблицы
 
Доброго времени суток!
При помощи макрорекодера был записан макрос на создание сводной таблицы, по факту запуска которого возникает ошибка 1004
Вот код:

Код
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Sheets.Add After:=Sheets(Sheets.Count)
    Workbooks("Добавление данных000.xlsm").Connections.Add "База4", "", Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\Users\Voland\Desktop\Лин\999\База.accdb;Mode=Share De" _
        , _
        "ny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB" _
        , _
        ":Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OL" _
        , _
        "EDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale" _
        , _
        " on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False" _
        ), Array("Входящий_исходящий_поток"), 3
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _ ActiveWorkbook.Connections("База4"), Version:=xlPivotTableVersion12). _ CreatePivotTable TableDestination:="Лист4!R1C1", TableName:= _ "СводнаяТаблица1", DefaultVersion:=xlPivotTableVersion12
    Cells(1, 1).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ФИО")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Вид")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Дата")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("Территория")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("СводнаяТаблица1").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица1").PivotFields("Количество"), "Сумма по полю Количество", _
        xlSum
    ActiveWorkbook.ShowPivotTableFieldList = False
End Sub
 
Ошибка выделяет данный фрагмент

Код
 ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ActiveWorkbook.Connections("База4"), Version:=xlPivotTableVersion12). _
        CreatePivotTable TableDestination:="Лист4!R1C1", TableName:= _
        "СводнаяТаблица1", DefaultVersion:=xlPivotTableVersion12 
Подскажите, пожалуйста, как то неё избавиться?
 
может не нужен этот фрагмент? без файла трудно понять
может достаточно пропустить ошибку
дописав перед кодом
Код
On Error Resume Next
Страницы: 1
Наверх