[已解决]【求助】runtime 1004

allanneo

各位高手，由于数据使用到两个表【Waste+】以及【Waste+Base】，所以我自己用VBA写Pivot透视表时，出现runtime 1004错误信息，忘能帮忙调试一下，不胜感激。

EnYT31jl.rar (140.06 KB, 下载次数: 5)

2010-1-25 11:02 上传

点击文件名下载附件
【求助】runtime 1004

最佳答案

月排行榜 / 总排行榜

amulee

2010-1-25 13:37

我一般用下面这样的形式创建。帮你写好了，格式啥的你自己修改。

Public Sub Waste_Plus()
    Dim adoCN As Object
    Dim strSQL As String
    Dim objPivotCache As Object
    '清除原数据表
    Range("M:IV").Delete
    '设定查询语句
    strSQL = "select 0 as [Date],Process,Category,DefectCode,0 " _
            & "as Waste from [Waste+Base$] union all select Date,Process,Category,DefectCode,Waste from [Waste+$]"
    '建立ADO连接对象
    Set adoCN = CreateObject("ADODB.Connection")
    '打开ADO连接
    adoCN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=Excel 8.0"
    '建立数据透视表缓存对象
    Set objPivotCache = ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlExternal)
    Set objPivotCache.Recordset = adoCN.Execute(strSQL)
    '创建透视表
    With objPivotCache
        .CreatePivotTable TableDestination:=Sheets("Database").Range("M7"), _
            TableName:="PT_Waste_Plus"
    End With
    '关闭连接
    adoCN.Close
    Set adoCN = Nothing
    Set objPivotCache = Nothing
    '设定透视表，这里你自己改
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("PT_Waste_Plus").PivotFields("Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PT_Waste_Plus").PivotFields("DefectCode")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PT_Waste_Plus").AddDataField ActiveSheet.PivotTables( _
        "PT_Waste_Plus").PivotFields("Waste"), "Sum of Waste" _
        , xlSum

End Sub

跳转到最佳答案楼层

amulee

有几个错误

"OLEDBrovider=Microsoft.Jet.OLEDB.4.0assword="""";User ID=Admin;Data Source=" & FileSource & ";Mode=Share De" _
        , _
        "ny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";J" _
        , _
        "et OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions" _
        , _
        "=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Co" _
        , _
        "py Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        )
        .CommandType = xlCmdTable
        .CommandText = Array( _
        "select 0 as [Date],Process,Category,DefectCode,0 as Waste from ['Waste+Base$'] union all select Date,Process,Category,DefectCode,Waste from ['Waste+$']" _
        )

allanneo

但是改正了之后，还是出现 Run-time error 1004，

The connection for viewing your linked microsoft Excel worksheet was lost

各位大虾能帮忙看看么？

amulee

在With ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)里面再加上

.MaintainConnection=True

试试看

allanneo

QUOTE:

以下是引用amulee在2010-1-25 12:45:00的发言：

在With ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)里面再加上

.MaintainConnection=True

试试看

加了，但还是不行哦

BTW，弱弱的问一下，为什么Date要加【】，而Waste不用加呢

amulee

QUOTE:

以下是引用allanneo在2010-1-25 12:47:00的发言：

加了，但还是不行哦

BTW，弱弱的问一下，为什么Date要加【】，而Waste不用加呢

Date是保留字啊

allanneo

我把改过后的文件重新上传了一遍，大侠们帮忙看看吧

g4510dIq.rar (140.21 KB, 下载次数: 2)

2010-1-25 13:08 上传

点击文件名下载附件
【求助】runtime 1004

amulee

我一般用下面这样的形式创建。帮你写好了，格式啥的你自己修改。

Public Sub Waste_Plus()
    Dim adoCN As Object
    Dim strSQL As String
    Dim objPivotCache As Object
    '清除原数据表
    Range("M:IV").Delete
    '设定查询语句
    strSQL = "select 0 as [Date],Process,Category,DefectCode,0 " _
            & "as Waste from [Waste+Base$] union all select Date,Process,Category,DefectCode,Waste from [Waste+$]"
    '建立ADO连接对象
    Set adoCN = CreateObject("ADODB.Connection")
    '打开ADO连接
    adoCN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=Excel 8.0"
    '建立数据透视表缓存对象
    Set objPivotCache = ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlExternal)
    Set objPivotCache.Recordset = adoCN.Execute(strSQL)
    '创建透视表
    With objPivotCache
        .CreatePivotTable TableDestination:=Sheets("Database").Range("M7"), _
            TableName:="PT_Waste_Plus"
    End With
    '关闭连接
    adoCN.Close
    Set adoCN = Nothing
    Set objPivotCache = Nothing
    '设定透视表，这里你自己改
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("PT_Waste_Plus").PivotFields("Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PT_Waste_Plus").PivotFields("DefectCode")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PT_Waste_Plus").AddDataField ActiveSheet.PivotTables( _
        "PT_Waste_Plus").PivotFields("Waste"), "Sum of Waste" _
        , xlSum

End Sub

allanneo

QUOTE:

以下是引用amulee在2010-1-25 13:37:00的发言：

我一般用下面这样的形式创建。帮你写好了，格式啥的你自己修改。

Public
  Sub Waste_Plus()
    Dim adoCN As
  Object
    Dim strSQL As
  String
    Dim objPivotCache As
  Object
    '清除原数据表
    Range("M:IV").Delete
    '设定查询语句
    strSQL = "select 0 as [Date],Process,Category,DefectCode,0 " _
            & "as Waste from [Waste+Base$] union all select Date,Process,Category,DefectCode,Waste from [Waste+$]"
    '建立ADO连接对象
    Set adoCN = CreateObject("ADODB.Connection")
    '打开ADO连接
    adoCN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=Excel 8.0"
    '建立数据透视表缓存对象
    Set objPivotCache = ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlExternal)
    Set objPivotCache.Recordset = adoCN.Execute(strSQL)
    '创建透视表
    With objPivotCache
        .CreatePivotTable TableDestination:=Sheets("Database").Range("M7"), _
            TableName:="PT_Waste_Plus"
    End
  With
    '关闭连接
    adoCN.Close
    Set adoCN = Nothing
    Set objPivotCache = Nothing
    '设定透视表，这里你自己改
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("PT_Waste_Plus").PivotFields("Date")
        .Orientation = xlColumnField
        .Position = 1
    End
  With
    With ActiveSheet.PivotTables("PT_Waste_Plus").PivotFields("DefectCode")
        .Orientation = xlRowField
        .Position = 1
    End
  With
    ActiveSheet.PivotTables("PT_Waste_Plus").AddDataField ActiveSheet.PivotTables( _
        "PT_Waste_Plus").PivotFields("Waste"), "Sum of Waste" _
        , xlSum

End
  Sub

试了，可以了，

但我发现Date排列有问题，设置升序排列时，貌似不对，文件重新上传了，高手请帮忙解决一下

UpyXDflr.rar (257.33 KB, 下载次数: 2)

2010-1-25 16:53 上传

点击文件名下载附件

[此贴子已经被作者于2010-1-25 16:52:58编辑过]

king21c

附件怎么都下载不了