SQL+数据透视表+VBA 数据透视表的超级应用

Scarlett_88

SQL+数据透视表+VBA 使数据透视表走向更灵活，更智能，更适用。
这个是我和师傅一撇首度合作，他提供了文件并提出了要求，我帮他实现其效果
下面从几个方面解释一下：

1、功能
一个源文件和一个通过用SQL查询生成的数据透视表
将源文件拖到电脑的任意位置，甚至将文件名也改掉，用VBA配上代码和窗体找到文件，数据透视表仍然能够正常工作
2、套用
现在来讲讲怎么使做出来的东东适应大家的需要
2、1
用OLE DB窗口引用工作表或写SQL语句，因为用这个方法同VBA相通，copy下来代码区的的语句
2、2
打开透视表文件，将透视表中的字段全部拖出来，也就是变成一个空数据透视表。
右击下面工作表图标 或者 工具》宏》visual basic 编辑器，点击模块看到代码区
2、3
将2、1步骤copy的语句commandtext的数据Array中的引号中
.CommandText = Array("    ")
可能不同版本会有一些差别，同时SQL语句中如果添加了文本生成新字段，双引号要成对翻倍
如："出库" AS 表单选项 要改成 ""出库"" AS 表单选项
2、4
语句太长的处理：在代码区如果你想好看一些，你可以插入“ _”来换行，当然不能插在一个单词或自动名等中间。
2、5
将文件存盘，重新打开就会有了数据，你可以将字段拖入数据透视表中，创建你自己的数据透视表，
2、6
这样文件就可以使用，相信VBA的引导不用教就可以交给别人使用了

下面附上代码，包含3个区：

1、 工作簿去，打开文件时工作
Private Sub Workbook_Open()
Dim OP

If Dir(Sheets("path").Range("A1")) = "" Then
    OP = MsgBox("源文件已被移走，请选择下列选项" + Chr(10) + "1、选择是，重新输入文件全名" + Chr(10) + "2、选择否，打开原有的数据透视表" + Chr(10) + "3、选择取消，关闭文件", vbYesNoCancel, "Scarlett温馨提示")
    If OP = vbYes Then
        UserForm1.Show
    End If
    If OP = vbNo Then
        ActiveWorkbook.Close True
    End If
   
    If OP = vbCancel Then
        Exit Sub
    End If
   
Else
    Call refreshpv
End If
End Sub

2、窗体区，实现文件的查找
Private Sub CommandButton1_Click()
Dim fopen As FileDialog
Set fopen = Application.FileDialog(msoFileDialogFilePicker)
fopen.Show
TextBox1.Value = fopen.SelectedItems(1)
Set fopen = Nothing
End Sub

Private Sub CommandButton2_Click()
If InStr(TextBox1.Value, ".") > 0 Then
    Sheets("path").Range("A1") = TextBox1.Value
    Call refreshpv
    unload me
Else
    MsgBox "文件名要带路径含后缀的文件名", "Scarlett_88温馨提示"
    TextBox1.SetFocus
End If
End Sub

Private Sub CommandButton3_Click()
Unload Me
End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Activate()

End Sub

Private Sub UserForm_Click()
TextBox1.Value = Sheets("path").Range("A1")
End Sub

3、模块区，实现SQL语句的地址更新和刷新数据透视表的数据源

Sub refreshpv()
    With ActiveSheet.PivotTables("数据透视表1").PivotCache
        .Connection = Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=" & Sheets("path").Range("A1") & ";Mode=Share Deny Write;" _
        , _
        "Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Databa" _
        , _
        "se Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Je" _
        , _
        "t OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Com" _
        , "pact Without Replica Repair=False;Jet OLEDB:SFP=False")
        .CommandType = xlCmdTable
        .CommandText = Array( _
        "select ""期初""  AS 表单选项,规格型号,机器号,数量,0 as 数量3, 0 as 数量2, 金额,0 as 金额3, 0 as 金额2  from  [期初$]  union  all  select ""入库"" AS 表单选项,规格型号,机器号, 0" _
        , _
        " as 数量2, 数量,0 as 数量3, 0 as 金额2, 金额,0 as 金额3 from  [入库$]  union  all  select ""出库"" AS 表单选项,规格型号,机器号, 0 as 数量3, 0 as 数量2,数量, 0 as 金额3, 0 as 金额2,金额 from [出库$]" _
        )
    End With
    ActiveSheet.PivotTables("数据透视表1").PivotCache.Refresh
End Sub

[ 本帖最后由 Scarlett_88 于 2009-6-2 03:52 编辑 ]

BIN_YANG168

超级实用的东东,感谢分享。有时间再搞搞多工作簿数据源的、2007版本的吧。

bibisin

谢谢LZ分享

shlzml

可惜我没有师傅教我
只能自己瞎琢磨

Scarlett_88

原帖由 BIN_YANG168 于 2009-6-1 23:48 发表
超级实用的东东,感谢分享。有时间再搞搞多工作簿数据源的、2007版本的吧。

多工作簿的在考虑

xowi99

很是实用，感谢斯嘉丽分享，学习了。
ps：有这么多老师，羡慕ing……

Scarlett_88

原帖由 xowi99 于 2009-6-2 00:24 发表
很是实用，感谢斯嘉丽分享，学习了。
ps：有这么多老师，羡慕ing……

老师布置的作业要做的

zzzdbg

谢谢分享，好用，但看上去好难哦！

monvzhilei

那值得研究。这么多人晚上都很迟睡啊。真佩服。

开心萝卜惠州

期待更多的作品！