数据透视表自适应的VBA代码 总结

donghan

在导入外部数据创建数据透视表后,如果文件被移动后或改名后会出现找不到对象的警告，本人将我的数据透视表自适应的VBA代码整理如下：
一、创建数据透视表
1、外部文件为为文本文件：

Private Sub Workbook_Open()
  Dim strCon As String, iPath As String, i As Integer, iFlag As String, iStr As String
    '定义变量
    On Error Resume Next
    strCon = ActiveSheet.PivotTables(1).PivotCache.Connection
    '将当前活动数据透视表中缓存连接信息赋值给变量strCon
    Select Case Left(strCon, 5)  'select case语句,条件为strCon变量中从左侧取5个字符
    Case "ODBC;"                 '用于判断缓存连接信息中的数据连接方式,如果是ODBC方式
        iFlag = "DBQ="           '将"DBQ=" 赋值给变量iFlag
    Case "OLEDB"                 '用于判断缓存连接信息中的数据连接方式,如果是OLEDB方式
    iFlag = "Source="            '将"DBQ=" 赋值给变量iFlag
    Case Else
        Exit Sub
    End Select
    iStr = Split(Split(strCon, iFlag)(1), ";")(0)  '在变量strCon中截取文件路径信息         
   
    With ActiveSheet.PivotTables(1).PivotCache     '替换数据透视表中缓存信息中的文件完全路径
        .Connection = VBA.Replace(strCon, iStr, Path)
        .CommandText = VBA.Replace(.CommandText, iStr, Path)
    End With
End Sub

2、外部文件为Access数据库
Private Sub Workbook_Open()

    Dim strCon1 As String, strCon2 As String, iPath As String, i As Integer, iFlag As String, iStr As String
    '定义变量
    On Error Resume Next
    strCon1 = ActiveSheet.PivotTables(1).PivotCache.Connection    '将当前活动数据透视表中缓存连接信息赋值给变量strCon
  
    Select Case Left(strCon1, 5)  'select case语句,条件为strCon变量中从左侧取5个字符
    Case "ODBC;"                 '用于判断缓存连接信息中的数据连接方式,如果是ODBC方式
        iFlag = "DBQ="           '将"DBQ=" 赋值给变量iFlag
    Case "OLEDB"                 '用于判断缓存连接信息中的数据连接方式,如果是OLEDB方式
    iFlag = "Source="            '将"DBQ=" 赋值给变量iFlag
    Case Else
        Exit Sub
    End Select
   iStr = Split(Split(strCon1, iFlag)(1), ";")(0)  '在变量strCon中截取文件路径信息
   iStr = Left(iStr, InStrRev(iStr, "\") - 1)     
    With ActiveSheet.PivotTables(1).PivotCache     '替换数据透视表中缓存信息中的文件完全路径
        .Connection = VBA.Replace(strCon1, iStr, Path)
        .CommandText = VBA.Replace(.CommandText, iStr, Path)
    End With
End Sub

3、外部文件为EXECL文件
Private Sub Workbook_Open()
  Dim strCon As String, iPath As String, i As Integer, iFlag As String, iStr As String
    '定义变量
    On Error Resume Next
    strCon = ActiveSheet.PivotTables(1).PivotCache.Connection
    '将当前活动数据透视表中缓存连接信息赋值给变量strCon
    Select Case Left(strCon, 5)  'select case语句,条件为strCon变量中从左侧取5个字符
    Case "ODBC;"                 '用于判断缓存连接信息中的数据连接方式,如果是ODBC方式
        iFlag = "DBQ="           '将"DBQ=" 赋值给变量iFlag
    Case "OLEDB"                 '用于判断缓存连接信息中的数据连接方式,如果是OLEDB方式
    iFlag = "Source="            '将"DBQ=" 赋值给变量iFlag
    Case Else
        Exit Sub
    End Select
    iStr = Split(Split(strCon, iFlag)(1), ";")(0)  '在变量strCon中截取文件路径信息
      iStr = Left(iStr, InStrRev(iStr, "\") - 1)         
   
    With ActiveSheet.PivotTables(1).PivotCache     '替换数据透视表中缓存信息中的文件完全路径
        .Connection = VBA.Replace(strCon, iStr, Path)
        .CommandText = VBA.Replace(.CommandText, iStr, Path)
    End With
End Sub

二、创建查询表
Private Sub Workbook_Open()
    Dim strCon As String, iPath As String, i As Integer, iFlag As String, iStr As String
    strCon = ActiveSheet.QueryTables(1).Connection
   
    Select Case Left(strCon, 5)
    Case "ODBC;"
        iFlag = "DBQ="
    Case "OLEDB"
        iFlag = "Source="
    Case Else
        Exit Sub
    End Select
    iStr = Split(Split(strCon, iFlag)(1), ";")(0)  '在变量strCon中截取文件路径信息
    iStr = Left(iStr, InStrRev(iStr, "\") - 1)      
    With ActiveSheet.QueryTables(1)
         .Connection = VBA.Replace(strCon, iStr, Path)
        .CommandText = VBA.Replace(.CommandText, iStr, Path)
    End With
End Sub

由上可看出，自动路径的代码大致一样，只有红色部分有变化，大家可以根据需要，自己测试其它类型的外部数据源，代码一样的可以合并。
总结：1、如果创建的是数据透视表用PivotTables(1).PivotCache，
如果创建的是查询表用QueryTables(1).。
2、如果外部数据源不可再分（如TXT文件），用
iStr = Split(Split(strCon, iFlag)(1), ";")(0) ，
如果外部数据源可再分（如EXECL文件，可分为SHEET1、SHEET2。。。，ASSECC文件可再分为表、视图等），此时用   
iStr = Split(Split(strCon, iFlag)(1), ";")(0)  
      iStr = Left(iStr, InStrRev(iStr, "\") - 1)   
  
本文参考JSSY版主的代码
http://club.excelhome.net/thread-472788-1-1.html
以上代码如有不对之处，大家可以再一起研究

[ 本帖最后由 donghan 于 2010-7-21 08:21 编辑 ]

monvzhilei

donghan兄台。已经测试过。ok的。

donghan

看来大家对这些代码不感兴趣呀

hf1971

谢谢楼主分享,VBA看不懂,要用时在论坛上摘的.

zyh196712

谢谢分享！

donghan

能得到jssy版主的认可就没有白忙

jenson999

测试了，没有通过呢

yanjie

msdn上有这个问题的代码和论述。

donghan

原帖由 yanjie 于 2010-4-11 16:35 发表
msdn上有这个问题的代码和论述。

给个连接吧

youliqi

有总结，就会有提高